|
▼Haruka さん:
すこしわかりにくいかもしれませんが、地域ごとのブロック取得を別方式で。
各行の各項目の扱いも記述方式をかえてみました。
Sub Test2()
Dim bs As Worksheet
Dim ws As Worksheet
Dim Break As Boolean
Dim dist As Variant
Dim cnt As Variant
Dim com As Variant
Dim qty As Long
Dim amt As Long
Dim pl As Long
Dim col As Variant
Dim z As Variant
Dim allAreas As Range
Dim myArea As Range
Dim c As Range
Application.ScreenUpdating = False
Set bs = Sheets("元データ")
cnt = bs.Range("H1").Value '月コード
'A列から地域コードごとの領域を分割して一挙取得
Set allAreas = bs.Range("A2", bs.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
For Each myArea In allAreas.Areas '個々の地域コード領域を取り出す
Break = True '最初の行は地域データ
For Each c In myArea '各データ行
If Break Then '地域コード行
dist = c.Value
Select Case dist
Case 1085, 1091, 1103, 1039, 1132
Set ws = Worksheets("America")
Case 1230
Set ws = Worksheets("China")
Case Else
MsgBox "(" & dist & ") 該当する代理店がありません"
Set ws = Nothing
End Select
Break = False
If Not ws Is Nothing Then
'地域シートの3行目で月コードの存在する列番号を取得
col = Application.Match(cnt, ws.Range("A1", ws.UsedRange).Rows(3), 0)
If IsError(col) Then
MsgBox "(" & cnt & ")月コードが" & ws.Name & "にないのでスキップします"
Set ws = Nothing
End If
End If
Else
Break = False
If Not ws Is Nothing Then '地域シートが存在する場合のみ対象
With c.EntireRow
com = .Range("A1").Value '商品コード
qty = .Range("C1").Value '数量
amt = .Range("D1").Value '金額
pl = .Range("E1").Value '利益
End With
'地域シートの該当商品コードの行を取得
z = Application.Match(com, ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)), 0)
If IsError(z) Then
MsgBox "(" & com & ")商品コードが" & ws.Name & "にないのでスキップします"
Else
With ws.Cells(z, col - 3)
.Range("D1").Value = .Range("D1").Value + qty
.Range("E1").Value = .Range("E1").Value + amt
.Range("F1").Value = .Range("F1").Value + pl
End With
End If
End If
End If
Next
Next
End Sub
|
|