[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA』（ころ）
下記のようなデータ（行が１０,０００ほど）があります。
１行目タイトル
２行目からデータ
【処理前】
A B C D E F G
1 ｺｰﾄﾞ1 名称1 ｺｰﾄﾞ2 名称2 金額 ｺｰﾄﾞ1合計 ｺｰﾄﾞ2割合
2 001 小計 1000
3 001 青木 3201 青木1 1000
4 002 小計 4500
5 002 赤木 4455 赤木1 1000
6 002 赤木 4456 赤木2 2000
7 002 赤木 4457 赤木3 1500
8 003 小計 8000
9 003 高木 8231 高木1 2000
10 003 高木 8232 高木2 6000
【処理後】
A B C D E F G
1 ｺｰﾄﾞ1 名称1 ｺｰﾄﾞ2 名称2 金額 ｺｰﾄﾞ1合計 ｺｰﾄﾞ2割合
2 001 小計 1000 1000 100
3 001 青木 3201 青木1 1000 1000 100
4 002 小計 4500 4500 100
5 002 赤木 4455 赤木1 1000 4500 22.2
6 002 赤木 4456 赤木2 2000 4500 44.4
7 002 赤木 4457 赤木3 1500 4500 33.3
8 003 小計 8000 8000 100
9 003 高木 8231 高木1 2000 8000 25
10 003 高木 8232 高木2 6000 8000 75
?@Ｂ列に”小計”という文字があったら、
そのセルから右に３つ目のセル（Ｅ列）の値をコピーして
すぐ右のセル（Ｆ列）に張り付ける
これをデータが無くなるまで繰り返す。
?AＦ列のデータにおいて、直下のセルが空白なら次の値の入っている
空白セルを上の値で埋める（コピー貼り付け）
これをデータが無くなるまで繰り返す。
?BＧ列に「＝Ｅ列/Ｆ列×100」の数式をＦ列にデータがある限り入力する。
以上の処理をしたいのですが
手作業で張り付けるのには時間がかり
ＶＢＡで処理できたらと思いました。
色々なサイトのコードを見よう見まねで記入しましたが、
根本的に理解していない事が多い為、全く動きません。
Sub Percentage()
Dim myc1 As Range, myc2 As Range Dim myc3 As Range, myc4 As Range Dim kw As String Dim i As Variant, k As Variant
For Each myc1 In Columns(1)
kw = "小計"
Set myc1 = Columns(1).Find(kw, LookAt:=xlWhole)
Set myc2 = myc1.Offset(0.4)
myc2.Value = i
Set myc3 = myc2.Offset(0.1)
myc3.Value = k
If Not myc1 Is Nothing Then
i.Copy.myc3
Next
End If
Dim blanks As Range
Set blannks = Range("F1").CurrentRegion.Columns(6).SpecialCells(xlCellTypeBlanks)
For Each k In blanks.Areas
k.Value = "'=" & k.End(xlUp).Address(0, 0)
k.Value = k.Value
Next k
End Sub
どなたか分かりやすく教えて頂けたら大変有難いです。
宜しくお願い致します。
＜ 使用 Excel：unknown、使用 OS：unknown ＞
この作業って、ｺｰﾄﾞ2割合の結果が必要なだけなら VBA使わずにピボットテーブルでやるのが早いですよ
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1:G9").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R9C7", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet2!R3C1", TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1", DefaultVersion _
:=xlPivotTableVersion15
Sheets("Sheet2").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("ｺｰﾄﾞ1")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("名称1")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("ｺｰﾄﾞ2")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("名称1")
.PivotItems("小計").Visible = False
End With
ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").AddDataField ActiveSheet.PivotTables( _
"ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("金額"), "データの個数 / 金額", xlCount
With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("データの個数 / 金額")
.Caption = "合計 / 金額"
.Function = xlSum
End With
ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").AddDataField ActiveSheet.PivotTables( _
"ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("金額"), "データの個数 / 金額", xlCount
With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("データの個数 / 金額")
.Caption = "合計 / 金額2"
.Function = xlSum
.Calculation = xlPercentOfParentRow
.NumberFormat = "0.00%"
End With
End Sub
（´・ω・`） 2020/01/31(金) 10:11
あ、書き込んじゃった
上で書き込んだマクロは、マクロの記録をしたものなので 手直ししてください。
多分シート名とか変えないとエラーになると思います。 （´・ω・`） 2020/01/31(金) 10:15
Sub test()
Dim i As Long
Dim iMax As Long
iMax = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To iMax
If Cells(i, "B").Value = "小計" Then
Cells(i, "F").Value = Cells(i, "E").Value
End If
Next i
For i = 3 To iMax
If Cells(i, "F").Value = "" Then
Cells(i, "F").Value = Cells(i - 1, "F").Value
End If
Next i
Range("G2:G" & iMax).Formula = "=$E2/$F2*100"
End Sub
（???） 2020/01/31(金) 10:17
（´・ω・`）さん、ピボットテーブルで処理する方法は思いつきもしませんでした。
色々な方法があるのですね。とても参考になりました。
ありがとうございました。
（???）さん、仰るとおりです。似たような処理のものをくっつけて貼り付けました。
本や、サイトでコードの意味を理解しながら加工しようとしましたが行き詰ってしまいました。
とてもシンプルで分かりやすかったです。
ありがとうございました。
VBAは自分にはとても難しいですが、少しずつ勉強していきたいと思います。
お二人ともありがとうございました。
（ころ） 2020/01/31(金) 11:25
(１) For Each ～ Next で使用している「myc1」 とFindメソッドの結果を格納する「myc1」
同じ変数を使っちゃってます。
(２) Findメソッドについて、LookInを省略すると、前回検索を承継することがあるので
【何を】検索対象とするのか明示した方がいい。
(３) Offsetプロパティについて「．（ドット）」ではなく、「，（カンマ）」で区切る。
(４) 「myc2」や「myc3」をいちいちセットしてるけど、「myc1.Offset(0,4)」や
「myc.Offset(0,5)」にそのまま代入可能
ただ、 「i」「k」共にVariant型で宣言されて何も値が入ってないので初期値のEmptyのまま。
よって、Emptyを代入するくらいならクリアにした方がコードとしては分かりやすい。
(先に「i」「k」に入れ忘れただけっぽいけど)
(５) Findメソッドによる検索で見つからなかったときに「myc1」に「Nothing」が格納される。
なので、「myc1」を使う前に、当該がNothingじゃないときだけ処理をするようにすべき。
(６) 「i.Copy.myc3」について構文が間違ってる
1) Variant型の初期値であるEmptyを「.Copy」できない
2) 「myc1.Copy.myc3」の間違いだとしたら、「myc1.Copy myc3」のように
Copyメソッドの引数「Destination」を指定したい場合は半角スペースを挟んで入れる（「.（ドット）」で繋がない）
(７) 「Next」と「 End If」の順番が逆
(８) 「Set blannks」で変数名を間違えてます
(８) 「.SpecialCells」について、 該当セルが無かった場合のことも考えるべき
(９) 値がほしいだけなら「 k.Value = k.End(xlUp).Value 」でよい
ってところが気になります。
■２
＞色々なサイトのコードを見よう見まねで記入しましたが、根本的に理解していない事が多い為、全く動きません。
自覚があるようですが、適当に並べても動くものではありません。（提示のものは、コンパイルエラーになるから動かす以前の問題ですけど・・）
＞本や、サイトでコードの意味を理解しながら加工しようとしましたが行き詰ってしまいました。
同時並行ではなく。それぞれが何をやっているのか【元々の】コードをステップ実行して理解するようにしてから、必要な部分だけ組み合わせるべきです。
さらに、【自分で作ったコード】もステップ実行して、想定どおりにうごいているか、動いていないならどこがおかしいのかチェックすべきです。
■３
＜ 使用 Excel：unknown、使用 OS：unknown ＞なので詳細は分かりませんが、本当に提示されたようなことであれば、お使いのバージョンがExcel2007～であれば【SUMIFS関数】でたやすく対応できます。
(1) F2 =SUMIFS(E:E,A:A,A2,B:B,"<>小計") (2) G2 =ROUND(E2/F2*100,1) (3) F2:G２セルを最終行までフィルコピー
これでおしまい。
■４
仮に、どーしてもマクロじゃなきゃ困るというなら↓みたいに数式をマクロで設定してみてはどうでしょうか？
Sub てきとー()
Dim 最終行 As Long
With ActiveSheet
最終行 = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("F2").Formula = "=SUMIFS(E:E,A:A,A2,B:B,""<>小計"")"
.Range("G2").Formula = "=ROUND(E2/F2*100,1)"
With .Range("F2:G2").Resize(最終行 - 1)
.Rows(1).AutoFill Destination:=.Cells, Type:=xlFillDefault
.Value = .Value
End With
End With
End Sub
（もこな２） 2020/01/31(金) 16:31
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.