[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『転記が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.