Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5355 / 76732

←次へ　｜　前へ→


	【76990】Re:【VBA】不特定数データを検索したシートに足し込み

β - 15/4/24(金) 18:00 -


	引用なし

	パスワード

▼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
　　　　　　　　'地域シートの３行目で月コードの存在する列番号を取得
　　　　　　　　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

299 hits

▼

【76983】【VBA】不特定数データを検索したシートに足し込み Haruka 15/4/24(金) 11:10