[[20141001185246]] 『転記が1行ずれたら?』(坂本) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『転記が1行ずれたら?』(坂本)

 Sheet1のデータからSheet2へ転記させるマクロです。Sheet2(B2基準)に転記している
 ものをSheet3(B3基準)にも転記したいのですが、下記のコードに付け足したいと思い
 ます。ご教示お願いします。

 Sheet1                         Sheet2
      A      B    C     D       A      B    C  D    E  F
 1  営業所 数量  型式 名前  5000  森田 石田 山本 坂本 鈴木      
 2  W       2 20-1 森田     20-1
 3   S       3  20-3  石田     20-2    
 4   W       2  20-5 山本     20-3
 5   S       1  20-3 石田     20-4
 6   W       4  20-2 坂本     20-5
 7   W       3  20-2 坂本
 8   E       4  20-4  鈴木

                               Sheet3
                                A      B    C    D     E   F
                           1           -    -    -     -     -  
                           2    -  森田  石田  山本  坂本  鈴木      
                           3   20-1
                           4   20-2    
                           5   20-3
                           6   20-4
                           7   20-5

 Sub test1()

  Dim tbl    As Variant
  Dim Dat()  As Double
  Dim buf    As String
  Dim i      As Long
  Dim j      As Long

 tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
   With CreateObject("Scripting.Dictionary")

 For i = 2 To UBound(tbl, 1)
   buf = Format(tbl(i, 3)) & vbTab & tbl(i, 1) & vbTab & tbl(i, 4)
      .Item(buf) = .Item(buf) + tbl(i, 2)
    Next i

 With Worksheets("Sheet2").Range("A1").CurrentRegion
      tbl = .Value

 ReDim Dat(1 To .Rows.Count - 1, 1 To .Columns.Count - 1)
    End With

 For i = 2 To UBound(tbl, 1)
 For j = 2 To UBound(tbl, 2)

 Dat(i - 1, j - 1) = .Item(Format(tbl(i, 3)) & vbTab & tbl(i, 1) & vbTab & tbl(i, 4))
      Next j
    Next i
  End With

Worksheets("Sheet2").Range("B2").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat

End Sub

< 使用 Excel:Excel2007、使用 OS:Windows7 >


 全体を見ていないですけど、

 >Worksheets("Sheet2").Range("B2").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat 

 上のステートメントに倣えばいいんじゃないですか?

  Worksheets("Sheet3").Range("B3").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat 

(半平太) 2014/10/01(水) 19:59


 ありがとうございます。
 B2基準で転記の場合は
 Worksheets("Sheet2").Range("B2").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat

 B3基準
 Worksheets("Sheet3").Range("B3").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Datですと
 B4基準になってしまいます。

 With Worksheets("Sheet2").Range("A1").CurrentRegion
      tbl = .Value  以下のコードの意味が理解できていないので対応できません。

 解説いただけないでしょうか?

(坂本) 2014/10/02(木) 06:16


 その表のA1を選択して、キーボードのCtrl+Shift+:(またはテンキーのCtrl+*)
 を押してみてください。
 それと同じ動作です。 →.CurrentRegion
( 稲葉) 2014/10/02(木) 07:46

 今度は、全体を見てみました。
 ご提示のデータが正しいとするなら
 ご提示のコードが意図通り作動しているとは思えません。

 営業所(W、S、E)への配慮は何処に行っちゃたんですか?

 まぁ、Sheet2には営業所の表示がないので、配慮したくても出来ないとも思いますけど、
 とにかく、問題点とサンプル(データ、コード)がマッチしていないと思います。

(半平太) 2014/10/02(木) 09:07


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.