Excel VBA質問箱 IV

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

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


9337 / 76732 ←次へ | 前へ→

【72957】Re:足し算と掛け算の入った転記方法
発言  UO3  - 12/10/17(水) 11:18 -

引用なし
パスワード
   ▼マリモ さん:

こんにちは。たとえば。

Sub Sample()
  Dim c As Range
  Dim v() As Variant
  Dim dkey As String
  Dim dic As Object
  Dim x As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  With Sheets("Sheet2")
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      dkey = c.Value & vbTab & c.Offset(, 1).Value
      dic(dkey) = dic.Count + 1 '1からの連番
    Next
  End With
  
  ReDim v(1 To dic.Count, 1 To 3)
  
  With Sheets("Sheet1")
    For Each c In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
      dkey = c.Value & vbTab & c.Offset(, 1).Value
      If dic.exists(dkey) Then  'Sheet2に記載あれば
        x = dic(dkey)
        v(x, 1) = v(x, 1) + c.Offset(, 2).Value '通数足しこみ
        v(x, 2) = c.Offset(, 3).Value      '単価
        '金額計算をしたものを足しこみ
        v(x, 3) = v(x, 3) + c.Offset(, 2).Value * c.Offset(, 3).Value
      End If
    Next
  End With
  
  With Sheets("Sheet2")
    .Range("C2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    .Select
  End With
  
  MsgBox "処理完了"
  
End Sub
0 hits

【72956】足し算と掛け算の入った転記方法 マリモ 12/10/17(水) 10:44 質問
【72957】Re:足し算と掛け算の入った転記方法 UO3 12/10/17(水) 11:18 発言
【72958】Re:足し算と掛け算の入った転記方法 マリモ 12/10/17(水) 13:02 発言
【72959】Re:足し算と掛け算の入った転記方法 ウッシ 12/10/17(水) 14:05 回答
【72974】Re:足し算と掛け算の入った転記方法 マリモ 12/10/18(木) 14:47 お礼

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