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
        '地域シートの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
300 hits

【76983】【VBA】不特定数データを検索したシートに足し込み Haruka 15/4/24(金) 11:10 質問[未読]
【76984】Re:【VBA】不特定数データを検索したシート... 独覚 15/4/24(金) 11:20 発言[未読]
【76985】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/24(金) 11:27 回答[未読]
【76986】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 11:48 発言[未読]
【76987】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 14:07 発言[未読]
【76988】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/24(金) 16:23 発言[未読]
【76990】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 18:00 発言[未読]
【76991】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 19:32 発言[未読]
【76992】Re:【VBA】不特定数データを検索したシート... β 15/4/25(土) 6:23 発言[未読]
【76993】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/27(月) 9:23 発言[未読]
【76994】Re:【VBA】不特定数データを検索したシート... β 15/4/27(月) 9:43 発言[未読]
【76995】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/27(月) 15:04 質問[未読]
【76996】Re:【VBA】不特定数データを検索したシート... β 15/4/27(月) 15:52 発言[未読]
【76997】Re:【VBA】不特定数データを検索したシート... β 15/4/28(火) 7:21 発言[未読]
【76998】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/28(火) 10:26 お礼[未読]

5355 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free