HOME > Q&A > Excel （VBA）

Excel （VBA）
Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Pro : Excel 2019)
2次元の配列で
投稿日時: 23/06/13 15:09:20
投稿者: ffftp

こんにちはffftpです。
 
いま２次元の配列に以下のようにデータを格納しています。
左側が売上営業所ID、右側が仕入営業所ID、最後が金額です。
GroupValue(1,2) = -1198047
GroupValue(1,3) = -776214
GroupValue(1,4) = 1508616
GroupValue(2,1) = 1200780
GroupValue(2,3) = -383483
GroupValue(2,4) = 21704
GroupValue(3,1) = 776214
GroupValue(3,2) = 383483
GroupValue(3,4) = -91303
GroupValue(4,1) = -1506205
GroupValue(4,2) = -21704
GroupValue(4,3) = 91303
 
このデータを活かして、以下のような表を作成したいと思っております。
売上営業所ID・仕入営業所ID・売上金額・仕入金額・差額
1　　　　　　2　　　　　　　-1198047　1200780　 2733
1　　　　　　3　　　　　　　-776214　　776214 0
1　　　　　　4　　　　　　　1508616　-1506205 2411
2　　　　　　3　　　　　　　-383483　　383483　　　0
 
最終的なイメージはできたのですが、自分の力不足です。
お力をお貸しください。
回答
投稿日時: 23/06/13 16:07:35
投稿者: sk

（標準モジュール）
-----------------------------------------------------------
Sub Test1()
 
    Dim GroupValue(1 To 4, 1 To 4) As Variant
     
    GroupValue(1, 2) = -1198047
    GroupValue(1, 3) = -776214
    GroupValue(1, 4) = 1508616
    GroupValue(2, 1) = 1200780
    GroupValue(2, 3) = -383483
    GroupValue(2, 4) = 21704
    GroupValue(3, 1) = 776214
    GroupValue(3, 2) = 383483
    GroupValue(3, 4) = -91303
    GroupValue(4, 1) = -1506205
    GroupValue(4, 2) = -21704
    GroupValue(4, 3) = 91303
 
    Dim NewSheet As Worksheet
    Dim DestinationRow As Long
     
    Set NewSheet = Workbooks.Add.Worksheets(1)
     
    DestinationRow = 1
     
    With NewSheet
        .Cells(DestinationRow, 1).Value = "売上営業所ID"
        .Cells(DestinationRow, 2).Value = "仕入営業所ID"
        .Cells(DestinationRow, 3).Value = "売上金額"
        .Cells(DestinationRow, 4).Value = "仕入金額"
        .Cells(DestinationRow, 5).Value = "差額"
    End With
     
    Dim x As Long
    Dim y As Long
    Dim SalesAmount As Variant
    Dim PurchaseAmount As Variant
     
    For x = LBound(GroupValue, 1) To UBound(GroupValue, 1)
        For y = LBound(GroupValue, 2) To UBound(GroupValue, 2)
            SalesAmount = Empty
            PurchaseAmount = Empty
            If IsEmpty(GroupValue(x, y)) = False And IsNumeric(GroupValue(x, y)) = True Then
                SalesAmount = CDec(GroupValue(x, y))
            End If
            If IsEmpty(GroupValue(y, x)) = False And IsNumeric(GroupValue(y, x)) = True Then
                PurchaseAmount = CDec(GroupValue(y, x))
            End If
            If IsEmpty(SalesAmount) = False And IsEmpty(PurchaseAmount) = False Then
                DestinationRow = DestinationRow + 1
                With NewSheet
                    .Cells(DestinationRow, 1).Value = x
                    .Cells(DestinationRow, 2).Value = y
                    .Cells(DestinationRow, 3).Value = SalesAmount
                    .Cells(DestinationRow, 4).Value = PurchaseAmount
                    .Cells(DestinationRow, 5).Value = SalesAmount + PurchaseAmount
                End With
                GroupValue(x, y) = Empty
                GroupValue(y, x) = Empty
            End If
        Next
    Next
 
    Set NewSheet = Nothing
 
End Sub
-----------------------------------------------------------
 
以上のようなマクロを実行したい、ということでしょうか。
回答
投稿日時: 23/06/13 16:10:38
投稿者: Suzu

どう ロジックを組んで判らないという話なのか、
どの段階で困っているのかが判りません。
 
とりあえず、そのままExcelに 出力し、Excelの一般機能で 考えてみてはどうでしょう？
 
https://dekiru.net/article/20383/
【エクセル時短】クロス集計表をリスト形式に戻す方法。元データがなくてもピボットテーブルウィザードで解決！
投稿日時: 23/06/13 16:23:17
投稿者: ffftp

Suzu様　ありがとうございます。
 
説明不足で申し訳ありませんでした。
VBAで組みたいを思っていましたが、配列でVBAを組むことの経験不足でデータを配列内に格納するところまではできたのですが、そこで頭がオーバーフローしてしまいました。
VBAにこだわらず、一般機能でもできることを知りました。
もっと色々な知識を身に着けていきたいと思います。
 
ありがとうございました。
 

Suzu さんの引用:
どう ロジックを組んで判らないという話なのか、
どの段階で困っているのかが判りません。
 
とりあえず、そのままExcelに 出力し、Excelの一般機能で 考えてみてはどうでしょう？
 
https://dekiru.net/article/20383/
【エクセル時短】クロス集計表をリスト形式に戻す方法。元データがなくてもピボットテーブルウィザードで解決！

 
投稿日時: 23/06/13 16:30:17
投稿者: ffftp

ｓｋ様　ありがとうございます。
 
質問の内容がわかりずらい中、いろいろと考えていただきありがとうございます。
ＳＫ様の回答が求めていたものと一致しております。
 
回答いただいたソースの内容がどういうことなのか、勉強させていただきます。
本当にありがとうございました。
 

sk さんの引用:
（標準モジュール）
-----------------------------------------------------------
Sub Test1()
 
    Dim GroupValue(1 To 4, 1 To 4) As Variant
     
    GroupValue(1, 2) = -1198047
    GroupValue(1, 3) = -776214
    GroupValue(1, 4) = 1508616
    GroupValue(2, 1) = 1200780
    GroupValue(2, 3) = -383483
    GroupValue(2, 4) = 21704
    GroupValue(3, 1) = 776214
    GroupValue(3, 2) = 383483
    GroupValue(3, 4) = -91303
    GroupValue(4, 1) = -1506205
    GroupValue(4, 2) = -21704
    GroupValue(4, 3) = 91303
 
    Dim NewSheet As Worksheet
    Dim DestinationRow As Long
     
    Set NewSheet = Workbooks.Add.Worksheets(1)
     
    DestinationRow = 1
     
    With NewSheet
        .Cells(DestinationRow, 1).Value = "売上営業所ID"
        .Cells(DestinationRow, 2).Value = "仕入営業所ID"
        .Cells(DestinationRow, 3).Value = "売上金額"
        .Cells(DestinationRow, 4).Value = "仕入金額"
        .Cells(DestinationRow, 5).Value = "差額"
    End With
     
    Dim x As Long
    Dim y As Long
    Dim SalesAmount As Variant
    Dim PurchaseAmount As Variant
     
    For x = LBound(GroupValue, 1) To UBound(GroupValue, 1)
        For y = LBound(GroupValue, 2) To UBound(GroupValue, 2)
            SalesAmount = Empty
            PurchaseAmount = Empty
            If IsEmpty(GroupValue(x, y)) = False And IsNumeric(GroupValue(x, y)) = True Then
                SalesAmount = CDec(GroupValue(x, y))
            End If
            If IsEmpty(GroupValue(y, x)) = False And IsNumeric(GroupValue(y, x)) = True Then
                PurchaseAmount = CDec(GroupValue(y, x))
            End If
            If IsEmpty(SalesAmount) = False And IsEmpty(PurchaseAmount) = False Then
                DestinationRow = DestinationRow + 1
                With NewSheet
                    .Cells(DestinationRow, 1).Value = x
                    .Cells(DestinationRow, 2).Value = y
                    .Cells(DestinationRow, 3).Value = SalesAmount
                    .Cells(DestinationRow, 4).Value = PurchaseAmount
                    .Cells(DestinationRow, 5).Value = SalesAmount + PurchaseAmount
                End With
                GroupValue(x, y) = Empty
                GroupValue(y, x) = Empty
            End If
        Next
    Next
 
    Set NewSheet = Nothing
 
End Sub
-----------------------------------------------------------
 
以上のようなマクロを実行したい、ということでしょうか。