Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
24 / 13618 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【82179】VBA いとう 23/8/21(月) 17:07 質問[未読]
【82190】Re:VBA マナ 23/8/24(木) 16:09 発言[未読]
【82192】Re:VBA いとう 23/8/28(月) 9:41 発言[未読]
【82193】Re:VBA マナ 23/8/28(月) 14:51 発言[未読]
【82194】Re:VBA いとう 23/8/28(月) 15:42 発言[未読]
【82195】Re:VBA マナ 23/8/29(火) 13:12 発言[未読]
【82196】Re:VBA いとう 23/8/29(火) 14:50 発言[未読]
【82197】Re:VBA マナ 23/8/29(火) 16:42 発言[未読]
【82190】Re:VBA
発言  マナ  - 23/8/24(木) 16:09 -
引用なし
パスワード
   ▼いとう さん：

データは計上日で降順ソートされている前提


Option Explicit

Sub test()
　　Dim dic As Object, aryl As Object
　　Dim 品目CD As String, 単価 As Long, 金額 As Long
　　Dim v, i As Long, k As String
　　
　　v = Cells(1).CurrentRegion.Value
　　
　　Set dic = CreateObject("scripting.dictionary")
　　Set aryl = CreateObject("system.collections.arraylist")
　　
　　For i = UBound(v) To 2 Step -1
　　　　品目CD = v(i, 1)
　　　　単価 = v(i, 3)
　　　　金額 = v(i, 4)
　　　　If 金額 > 0 Then
　　　　　　k = 品目CD & vbTab & 単価 & vbTab & 金額
　　　　　　aryl.Add i
　　　　　　If Not dic.exists(k) Then
　　　　　　Set dic(k) = CreateObject("system.collections.stack")
　　　　　　End If
　　　　　　dic(k).push i
　　　　Else
　　　　　　k = 品目CD & vbTab & 単価 & vbTab & 金額 * -1
　　　　　　aryl.Remove dic(k).pop
　　　　End If
　　Next
　　
　　aryl.Add 1
　　aryl.Reverse

　　v = Application.Index(v, Application.Transpose(aryl.toarray), Array(1, 2, 3, 4))
　　Worksheets.Add.Cells(1).Resize(UBound(v), 4).Value = v

End Sub
【82192】Re:VBA
発言  いとう E-MAIL  - 23/8/28(月) 9:41 -
引用なし
パスワード
   マナ様
成功しました。ありがとうございます。すごいです！

もしよろしければ勉強不足のである私に各プログラムの意味を記載して
いただけませんでしょうか。初めて知った部分もあるので知識をつけたく
なってしまいました。

まだお付き合いいただけますようでしたら、よろしくお願いいたします。
【82193】Re:VBA
発言  マナ  - 23/8/28(月) 14:51 -
引用なし
パスワード
   ▼いとう さん：

　　　 Ａ　　　 Ｂ　　　　 Ｃ　　 Ｄ
1　　品目CD　 計上日　　　単価　 金額
2　　ばなな　2022/8/31　　110　　110
3　　ばなな　2022/8/31　　100　　-100
4　　ばなな　2022/8/3 　　100　　200
5　　ばなな　2022/8/2 　　100　　100
6　　ばなな　2022/8/1 　　100　　100

まずは下記で行われていることを理解する必要があります。

Sub test2()
　　Dim v, a
　
　　v = Cells(1).CurrentRegion.Value
　　 a = Array(1, 2, 4, 6)　'抽出する行

　　v = Application.Index(v, Application.Transpose(a), Array(1, 2, 3, 4))
　　Worksheets.Add.Cells(1).Resize(UBound(v), 4).Value = v

End Sub
【82194】Re:VBA
発言  いとう E-MAIL  - 23/8/28(月) 15:42 -
引用なし
パスワード
   マナ様
Cells(1)がよくわかっておりませんが、
v = Application.Index(v, Application.Transpose(a), Array(1, 2, 3, 4))
1,2,3,4,の配列を取り出して転記する
Worksheets.Add.Cells(1).Resize(UBound(v), 4).Value = v
ワークシートを追加して行最大で4列のアクティブ領域の値を取り出して転記する

上記のような理解で合っておりますでしょうか？
【82195】Re:VBA
発言  マナ  - 23/8/29(火) 13:12 -
引用なし
パスワード
   ▼いとう さん：

>上記のような理解で合っておりますでしょうか？

わたしには、よくわかりません。
マクロを実行したうえで、そう考えたのであれば
他人にはわかりづらい表現というだけで、
たぶんあっているのでしょう。

下記のデータの場合は
test2を、どのように修正すればよいかわかりますか。

　　　 Ａ　　　 Ｂ　　　　 Ｃ　　 Ｄ
1　　品目CD　 計上日　　　単価　 金額
2　　ばなな　2022/8/31　　110　　110
3　　ばなな　2022/8/31　　100　　-100
4　　ばなな　2022/8/2 　　100　　100
【82196】Re:VBA
発言  いとう  - 23/8/29(火) 14:50 -
引用なし
パスワード
   マナ様
抽出する行を変更しました。

Sub test2()
　　Dim v, a
　
　　v = Cells(1).CurrentRegion.Value
　　 a = Array(1, 2)　'抽出する行

　　v = Application.Index(v, Application.Transpose(a), Array(1, 2, 3, 4))
　　Worksheets.Add.Cells(1).Resize(UBound(v), 4).Value = v

End Sub
【82197】Re:VBA
発言  マナ  - 23/8/29(火) 16:42 -
引用なし
パスワード
   ▼いとう さん：

そうです。
つまり、残したい行番号を自動で求めることができればよいのです。

今回は、arraylist という道具を利用しました。

arraylistの使い方はネットで調べてください。
何となくでもよいのでtest3 ↓が理解できないと
先に進めません。

Sub test3()
　　Dim aryl As Object
　　Dim v, i As Long
　
　　Set aryl = CreateObject("system.collections.arraylist")
　
　　For i = 6 To 2 Step -1
　　　　aryl.Add i
　　　　If i = 3 Or i = 5 Then
　　　　　　aryl.Remove i
　　　　End If
　　Next
　　
　　aryl.Add 1
　　aryl.Reverse

　　v = Application.Transpose(aryl.toarray)
　　Worksheets.Add.Cells(1).Resize(UBound(v)).Value = v

End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
24 / 13618 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free