|
▼Haruka さん:
以下で試してみてください。
Sub Test()
Dim bs As Worksheet
Dim ws As Worksheet
Dim mRow As Long
Dim i As Long
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
Application.ScreenUpdating = False
Set bs = Sheets("元データ")
mRow = bs.Range("A" & Rows.Count).End(xlUp).Row '元データ最終行番号
Break = True '最初の行は地域データ
cnt = bs.Range("H1").Value '月コード
For i = 2 To mRow
If Break Then '地域コード行
dist = bs.Cells(i, "A").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
If IsEmpty(bs.Cells(i, "A")) Then '地域データの間の空白行
Break = True '次の行は地域データ
Else '通常のデータ行
Break = False
If Not ws Is Nothing Then '地域シートが存在する場合のみ対象
com = bs.Cells(i, "A").Value '商品コード
qty = bs.Cells(i, "C").Value '数量
amt = bs.Cells(i, "D").Value '金額
pl = bs.Cells(i, "E").Value '利益
'地域シートの該当商品コードの行を取得
z = Application.Match(com, ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)), 0)
If IsError(z) Then
MsgBox "(" & com & ")商品コードが" & ws.Name & "にないのでスキップします"
Else
ws.Cells(z, "D").Value = ws.Cells(z, "D").Value + qty
ws.Cells(z, "E").Value = ws.Cells(z, "E").Value + amt
ws.Cells(z, "F").Value = ws.Cells(z, "F").Value + pl
End If
End If
End If
End If
Next i
End Sub
|
|