1

現在次のようなテーブルを変換する必要があります。

OI  Buy Securities for UPP          100000  0.622   0.624   62381.05
OI  Buy Securities for DIC          30000   1.57    1.575   47239.525
OI  Buy Securities for DIC          26220   1.57    1.574   41278.605
OI  Buy Securities for DIC          10000   1.57    1.574   15743.175
OI  Buy Securities for DIC          30000   1.57    1.574   47229.525
OI  Buy Securities for DIC          3780    1.57    1.574   5950.92
OI  Buy Securities for DIB          50000   3.18    3.189   159447.25
OI  Buy Securities for EMAAR    50000   5.3 5.315   265738.75
OI  Buy Securities for AIRARABIA    100000  1.22    1.223   122345.5

次のように表示するには:

OI  Buy Securities for UPP          100000  0.622   0.624   62381.05
OI  Buy Securities for DIC          100000  1.57    1.574   157441.75
OI  Buy Securities for DIB          50000   3.18    3.189   159447.25
OI  Buy Securities for EMAAR    50000   5.3 5.315   265738.75
OI  Buy Securities for AIRARABIA    100000  1.22    1.223   122345.5

この表は、私が発生した毎日のトランザクションのログです。同じ証券で同じ価格の取引を 1 つの取引に統合する必要があります。列は次のとおりです。証券の説明、出来高、株価、手数料後の平均価格、総取引額。その順序で。総取引額は、ボリューム*手数料後の平均価格です。最初のテーブルのほかに、この 2 番目のテーブルを作成する必要があるため、Excel シートの M 列以降になります。毎日、ブローカーから次のような新しいファイルを取得し、2 番目のテーブルのように変更する必要があります。VBAを使用してこれを自動化できる方法を教えてください。またはおそらくマクロ。残念ながら、ピボットテーブルを使用することはできません。それ以外の場合は非常に簡単でした。

4

1 に答える 1

0

これにより、必要なものが得られるはずです。この例では、Sheet1 と Sheet2 の両方が存在する必要があります。Sheet1 には開始データが含まれている必要があります。

Sub ConsolidateSpecial()
   ' 最初にワークエリアにシートをコピー
   For iRow = 1 To 65535
      If Worksheets("Sheet1").Cells(iRow, 1) = "" Then Exit For
      For iColumn = 1 To 5
         Worksheets("Sheet2") .Cells(iRow, iColumn) = Worksheets("Sheet1").Cells(iRow, iColumn)
      Next
   Next
   
   '
   iRowFirstSet = 1 から 65535のセルを照合する
      If Worksheets("Sheet2").Cells(iRowFirstSet, 1) = "" And Worksheets("Sheet2").Cells(iRowFirstSet, 2) = "" Then Exit For
      For iRowSecondSet = iRowFirstSet + 1 To 65535
         If Worksheets("Sheet2").Cells(iRowSecondSet, 1) = "" And Worksheets("Sheet2").Cells(iRowSecondSet, 2) = "" Then Exit For
         If Worksheets("Sheet2").Cells(iRowFirstSet, 1) = Worksheets("Sheet2").Cells(iRowSecondSet, 1) Then
            If Worksheets("Sheet2").Cells(iRowFirstSet, 3) = Worksheets("Sheet2") .Cells(iRowSecondSet, 3) Then
               Worksheets("Sheet2").Cells(iRowFirstSet, 2) = Worksheets("Sheet2").Cells(iRowFirstSet, 2) + Worksheets("Sheet1").Cells(iRowSecondSet, 2)
               ワークシート("Sheet2").Cells(iRowFirstSet, 4) = Worksheets("Sheet2").Cells(iRowSecondSet, 4)
               Worksheets("Sheet2").Cells(iRowFirstSet, 5) = Worksheets("Sheet2").Cells(iRowFirstSet , 5) + Worksheets("Sheet1").Cells(iRowSecondSet, 5)
               Worksheets("Sheet2").Cells(iRowSecondSet, 1).Clear
            End If
         End If
      Next
   Next
   
   '
   iRow の空白行を削除 = 1 から 65535
      If Worksheets("Sheet2").Cells(iRow, 1) = "" And Worksheets("Sheet2").Cells(iRow, 2) = "" Then Exit For
      If Worksheets("Sheet2").Cells(iRow, 1) = "" Then
         Worksheets("Sheet2").Rows(iRow).Delete
         iRow = iRow - 1
         If iRow < 1 Then iRow = 1
      End If
   Next
   
   MsgBox "done"
サブ終了

于 2013-11-29T01:48:54.823 に答える