条件付きで他のシートへ転記する。 よろしくお願いいたします。
質問
2022年7月22日金曜日 23:14
皆さま：
気が遠くなるような時間をかけてやっている手作業をなんとかVBAで自動でやりたいと考えて1年ぐらい経ちますが、どうしてもコードを思い描くことができません。
シート名 ”分析中”
シート名：”最終版” こうなるべき。 今は手動でやっています。
平たく言うと『分析中』というシートのコメントのセル値を『最終版』というシートの同じ部番号の行に貼り付ける作業です。『分析中』のコメントの14文字目(string)からの部番号が始まります。『分析中』のコメントを『最終版』の同じ部番号のコメントに貼り付けます。 もしくはA列の値が一致したらC列をコピーと言う形になるのかもしれません。
しかし、『分析中』から『最終版』に行くと、部番号の行番号が変化します。
ですので『分析中』のコメント列をガーっと選んでコピーして『最終版』に貼り付けても部番号がずれてしまいます。
よって今は手作業で一つ一つ目で追って部番号を合わせて貼り付けているのですが、全体としてとても大きい表なので非常に時間がかかります。こういうのをやるのは『条件付きの転記』というのでしょうか？
For Nextステートメントがかろうじて一枚のシート内なら使えます。しかしこれは2枚のシートに分かれているので2枚のシートに分かれているFor Nextの使い方がわかりません。
そもそもFor Nextを使わなくてもできるのかもしれませんが、どうしてもその方法がわかりません。
普段だったら少なくとも自分が作ったコードをいくつか挙げるのですが、この件に関しては全く見当がつかないので、いきなりご質問と言う形になって本当に恐縮です。
ご教授いただけると助かります。 よろしくお願いいたします。
LiLi803
すべての返信 (55)
2022年9月19日月曜日 12:24 ✅回答済み | 1 票
LiLi803 さま
Dictionary(連想配列のコード)を使用したサンプルをSub TENKI_DICTIONARY_V2()を参考にして作成してみました。
連想配列はキー文字列から行番号を取得できるようにしています。
Sub TENKI_DICTIONARY_V2()
Dim sheetA As Worksheet: Set sheetA = Worksheets("Analyze")
Dim sheetF As Worksheet: Set sheetF = Worksheets("Final")
Dim colComment As Long: colComment = Cells(9, Columns.Count).End(xlToLeft).Column - 5
Dim sheetADic As Dictionary ' キー → 行番号
Dim sheetFDic As Dictionary ' キー → 行番号
Set sheetADic = CreateDic(sheetA)
Set sheetFDic = CreateDic(sheetF)
Dim strKey As Variant
Dim rowA As Long
Dim rowF As Long
For Each strKey In sheetADic.Keys
rowA = sheetADic(strKey)
' 2022 9 19 修正しました
'If sheetA.Cells(rowA, colComment) <> "" Then
If sheetA.Cells(rowA, 3) <> "" And sheetA.Cells(rowA, colComment) <> "" Then
If sheetFDic.Exists(strKey) Then
rowF = sheetFDic(strKey)
sheetF.Cells(rowF, colComment) = sheetA.Cells(rowA, colComment)
Else
Call MsgBox("Final にキーなし：" & strKey)
End If
End If
Next
End Sub
Function CreateDic(sheet As Worksheet) As Dictionary
Dim accountNo As String
Dim strKey As String
Dim i As Long
Set CreateDic = New Dictionary
With sheet
For i = 11 To .Cells(Rows.Count, 2).End(xlUp).Row
If .Cells(i, 2) = "" And IsNumeric(Left(.Cells(i, 3), 6)) Then
accountNo = Left(.Cells(i, 3), 6)
End If
If .Cells(i, 2) <> "" Then
strKey = accountNo & .Cells(i, 2).Value
If CreateDic.Exists(strKey) Then
Call MsgBox("キー重複：" & strKey)
Else
Call CreateDic.Add(strKey, i)
End If
End If
Next
End With
End Function
参考になれば幸いです。
2022年7月22日金曜日 23:22
画像が貼れなかったのでもう一回トライしてみます。
シート名： 分析中
シート名 最終版
LiLi803
2022年7月23日土曜日 1:41
VLOOKUPでできそうですが、VBAにこだわる理由はあるのですか？
2022年7月23日土曜日 8:34
shasanoさんの質問ももっともとは思いますが、VBAで実装するのであれば、概要は次のようになるかなと。
切り出した「部番号」でA列を検索し、一致した行番行を取得し、その行のC列に転記するということになると思います。これを「分析中」シートの行数回ループ。
最後に、A列をキーにしてソートするという感じですかね（Sort関数）。
『「部番号」の行番号がずれる』というのはどういうことですか？
「2枚のシート」というのは「分析中」でしょうか「最終版」でしょうか？
「分析中」が２枚なら、１枚目のシートを処理して、ワークシート変更して、同様のことをする。「最終版」が２シートなら、１シート目と２シート目に保存する部番号を識別する必要がありますが。
2022年7月23日土曜日 10:39
LiLi803さん、今晩は。
他の回答者の疑問なども残っていますが、単純に考えて次の様なコード(分析中シートと最終版シートとが同じブックであり、そのブックの標準モジュールに作成するイメージ。)で対応できるのではないかと思います。しかし、本当は大きな表とのことですし、小生が理解できていない難しい問題がるのかもしれませんが、それが何なのか分かりませんので、とりあえず、投稿します。
Option Explicit
Sub sample()
Dim a As Worksheet
Dim b As Worksheet
Dim i As Long
Dim j As Long
Dim sData As String
Dim buNum As Long
Set a = ThisWorkbook.Worksheets("分析中")
Set b = ThisWorkbook.Worksheets("最終版")
With a
For i = 2 To 12
sData = .Cells(i, 3).Value
If sData <> "" Then
buNum = .Cells(i, 1).Value
For j = 4 To 19
If b.Cells(j, 1).Value = buNum Then
b.Cells(j, 3).Value = sData
Exit For
End If
Next j
End If
Next i
End With
End Sub
2022年7月24日日曜日 4:47
北海道の行がどこから現れたのか、それにもよりますが、PowerQueryなんでも実現できそうです。
2022年7月24日日曜日 22:10
Shasano様：
ご回答ありがとうございます。
この表、というか月別レポートなのですが、なかなか曲者で、毎月新しい月が列に追加され、縦にも横にも延々とデータが追加される仕様になっております。（縦は部番号が自由自在に増えたり減ったりする） しかも行にも列にもあらゆるところにアウトラインが設定されていて固定されているところがほとんどありません。おまけに会計項目別にたくさんのスペース行や小計行までくっついてきています。 よくぞまあこんなに醜いレポートを作ったものだ・・・と思うのですが、経営者側はこういうレポートを好むようです。 データベース教のわたしには信じられません。
よって毎月の表の流動的な変化にコード実行でコピーできるVBAでできないか１年・・・いや２年間ぐらい考えていました。
２年間ぐらい継続してあきらめていたのですが、上司の無茶ぶりに対抗するにはVBAしかない・・・と決心していま一度何がわからないのか整理し始めました。
LiLi803
2022年7月24日日曜日 22:39
口袋怪獣様：
ご回答ありがとうございます
「分析中」が1枚目です。 「分析中」というシートに途中経過の分析コメントをどんどんタイプ記入していきます。
そしてすべての業務が終わり「最終版」のレポートを出力します。それが２枚目です。
最終版である２枚目のレポートを出力すると他の従業員が入力したデータが追加されます。 他の従業員の担当している部番号が追加されるので、一気に行数が増えて（減る箇所もある）、「分析中」の部番号のもともとの行番号が、「最終版」では別の行番号にずれてしまいます。
「分析中」のコメントは「最終版」にもほぼほぼ使えるので転記したいのですが、行数がずれるので単なるコピー・ペーストで転記できず本当に苦労してました。
LiLi803
2022年7月24日日曜日 23:16
KokemomoYamamomo様：
ご回答ありがとうございます。
できました！！！希望の通りの転記ができました。!(0o0)!
心より感謝いたします。
しかし、今しばらくこの質問スレッドを閉じないままにしてよろしいでしょうか？
この質問に挙げさせていただいた表は簡易化したもので実際の「分析中」「最終版」レポートは縦にもっと長いレポートです。この簡易化した表のB列の「635000-その他在庫」というのが会計項目です。
この会計項目が多数あり、レポートでは会計項目、そして部番号のセットで縦に長く続いています。会計項目がA列、部番号がB列にあれば、もっと楽なのですが、会計項目はそれぞれのグループに一回しか出てきません。以下のようなイメージです。会計項目はもっとたくさんあります。
ですのでループで回すのに「分析」シートと「最終版」シートのそれぞれの会計項目の最初の行と最後の行を変数に;納しなくてはなりません。そして会計項目ごとのグループでループを回します。気が遠くなるような方法ですが、手動で一行一行位置を目で確かめてコピー・ペーストするよりかはましだと思っています。そして一回コードを組めば将来も毎月使えます。
ただ、このそれぞれの会計項目の最初の行と最後の行を変数に;納するというコードはまだ組めていません。
ですので今しばらくお時間を下さい。 そのコードを作成した後、全体の動作が達成できるか確認してみます。
また戻ってまいります。
よろしくお願いいたします。
LiLi803
2022年7月24日日曜日 23:31
佐祐理様：
お久しぶりでございます。いつもお世話になっております。
北海道が急に現れたのは「最終版」のレポートは他の従業員のデータも追加されるので・・・ということになります。わたしは北海道を担当していないのですが、北海道担当の従業員のデータ入力が最終版に統合されるとこのような結果になってしまいます。
PowerQueryは初めて知りました。調べてみましたが、Excelでこんなことができるのですね。 Microsoft Accessをエクセル上で使える・・・みたいな感覚でしょうか？（間違っていたらすみません）
今回の投稿の表はデータベースからはほど遠い仕様になっていますが、他にもデータベースを使った仕事があるのでそちらでチャレンジしてみたいと思います。
ありがとうございます。
LiLi803
2022年7月25日月曜日 2:02
KokwmomoYamamoto様：
こんばんわです！
先ほどのお返事から引き続きで大変恐縮なのですが、行番号を変数に;納する点において質問させていただいてよろしいでしょうか？
Dim その他在庫 As Integer '会計項目635000用
'635000-その他在庫のヘッダーの行番号を変数に;納する.
その他在庫 = .Range(.Cells(1, 2), .Cells(100, 2)).Find("635000-その他在庫").Row
各会計項目のHeaderの行番号を取得し、変数に;納するときに上記のようにFindメソッドを使いました。
これはこれで取得できます。
しかし問題があります。 わたしは同じような分析を２つの別々の会社用にやっているのですが、会計項目のStringがほんの少しだけ違います。 スペースが一つ多いとか、ハイフンがあるなしなどです。 ですのでFindで探すStringにワイルドカードを使いたくて
その他在庫 = .Range(.Cells(1, 2), .Cells(100, 2)).Find("635000*その他在庫").Row
などとFindのかっこの中のStringに＊を混ぜてしまうと作動しません。
Findメソッドでワイルドカードを使うにはどのようにしたらよいのでしょうか？
こういう場合はワイルドカードで対処するのではなく、完全不一致じゃなくてもよい・・・というパラメーターを追加するべきでしょうか？
転記には直接関係ないのですが、どうしても各会計項目の最初の行番号を取得しなくてはいけなくご質問させていただいています。
なお各会計項目の最終行は変数に入れないことにしました。 レポートでは各会計項目ごとに必ず１行の空白スペースがあるので、最終行は、次の会計項目番号の最初の行マイナス２ということで取得することにしました。
LiLi803
2022年7月25日月曜日 2:46
LiLi803さん、今日は。
先ず、先にご提示したコードが正しく動作したご報告を頂き、ありがとうございます。
次に、Findメソッドですが、小生は全くFindメソッドを使わないので、何とも的確なご返事をいたしかねます。
なお、Findメソッドを使って貼り付け先のセル範囲を指定するまでもなく、分析中シートのコメント欄のデータから部番号と品目コードを取得して最終版シートを検索すれば、目的のセルを特定してデータを転記することができると考えました。そのような考え方で、次の様なコードを作ってみました。
ご提示された画像のコードの書式やデータの書式が前提です。
分析中シートと最終版シートは別々のブックかもしれないので、vbaマクロの実行中に両方のシートを個別に指定する手順を組み込みました。このコードは、分析中シートや最終版シートのブックとは別のブックの標準モジュールにコピペして使用することができると思います。
Option Explicit
Sub sample2()
Dim sheetA As Worksheet
Dim sheetB As Worksheet
Dim i As Long
Dim j As Long
Dim sData As String
Dim itemData1 As String
Dim buNum As Long
Dim itemNum1 As Long
Dim blnkCount As Integer
Dim blnkCount2 As Integer
Dim itemData2 As String
Dim itemNum2 As Long
' Set a = ThisWorkbook.Worksheets("分析中")
Set sheetA = シートを指定する("分析中シートの適当なセルをクリックしてください。")
If sheetA Is Nothing Then
MsgBox "キャンセルされたので、終了します。"
Exit Sub
End If
' Set b = ThisWorkbook.Worksheets("最終版")
Set sheetB = シートを指定する("最終版シートの適当なセルをクリックしてください。")
If sheetB Is Nothing Then
MsgBox "キャンセルされたので、終了します。"
Set sheetA = Nothing
Exit Sub
End If
With sheetA
blnkCount = 1
i = 1
Do While blnkCount <= 20
itemData1 = .Cells(i, 2).Value
sData = .Cells(i, 3).Value
If blnkCount > 0 And itemData1 <> "" And sData <> "" Then
blnkCount = 0
ElseIf itemData1 <> "" And sData <> "" Then
If sData <> "コメント" Then
itemNum1 = CLng(Mid(sData, 7, 6))
buNum = CLng(Mid(sData, 14, 6))
blnkCount2 = 1
j = 2
Do While blnkCount2 <= 10
itemData2 = sheetB.Cells(j, 2).Value
If itemData2 <> "" Then
If blnkCount2 > 0 Then
itemNum2 = CLng(Left(itemData2, 6))
blnkCount2 = 0
Else
If itemNum2 = itemNum1 Then
If sheetB.Cells(j, 1).Value = buNum Then
sheetB.Cells(j, 3).Value = sData
Exit Do
End If
End If
End If
Else
blnkCount2 = blnkCount2 ; 1
End If
j = j ; 1
Loop
End If
ElseIf itemData1 = "" And sData = "" Then
blnkCount = blnkCount ; 1
End If
i = i ; 1
Loop
End With
End Sub
Private Function シートを指定する(ByVal strMsg As String) As Worksheet
'シートを指定するInputBoxを表示して、指定されたシートを返す。
'strMsg=メッセージ（InputBoxで表示されるメッセージ）
Dim myRetVal As Variant
On Error Resume Next
Set myRetVal = Application.InputBox(strMsg, Type:=8)
If myRetVal Is Nothing Then
Err.Number = 0
Exit Function
Else
Set シートを指定する = myRetVal.Worksheet
Set myRetVal = Nothing
End If
On Error GoTo 0
End Function
なお、Do~Loopを使っております。空白行が分析中シートでは20行、最終版シートでは10行を超えたら、処理を終えるようにしております。お使いのシートの体裁に応じて、修正してご使用ください。
2022年7月25日月曜日 3:34
LiLi803さん、今日は。その他在庫 = .Range(.Cells(1, 2), .Cells(100, 2)).Find("635000*その他在庫").Row ですが、正常に動作しましたが。次の3行目がフルスペックのようですが、2行目でも動きましたけれど。
with ActiveSheet
その他在庫 = .Range(.Cells(1, 2), .Cells(100, 2)).Find("635000*その他在庫").Row
その他在庫 = .Range(ActiveSheet.Cells(1, 2), .Cells(100, 2)).Find(what:="635000*その他在庫", lookat:=xlWhole).Row
end with
ただ、Findメソッドで個別に取得するより、処理の最初に上から下までDo~Loopで検索して、すべてのタイトルのヘッダーと行番号、そのヘッダーのセル範囲の最終行番号を配列変数に取得してしまった方が効率的なような気がしますが、いかがでしょうか？ただし、その後の処理でデータ（レコード）の挿入などがあって行がずれる場合があるとすれば、問題ですが。
2022年7月25日月曜日 5:43
KokemomoYamamono さんがコメント済みですが、Find は普通に動きます。ワイルドカードを使うなら完全一致でも部分一致でも関係ありません。なので原因は別にあると思います。
ただ提示された図を見る限りでは「スペースが一つ多いとか、ハイフンがあるなし」というのは「会計項目番号」以外の部分のことを言っていると思うので、であれば Find("635000"、LookAt:=xlPart) でよいのでは？
それから「最終行は、次の会計項目番号の最初の行マイナス２」だと、最後の会計項目で最終行が求められなくないですか？ 「各会計項目ごとに必ず１行の空白スペース」以外に空行が無いのであれば End プロパティを利用した方がよろしいかと。
2022年7月25日月曜日 12:10
LiLi803さん、今晩は。
多分、余計なお世話だと思うのですが、Findを使って、shasanoさんのアドバイスも取り入れて、最初にご提示したコードを活用する方向で、自分なりのコードを考えてみました。多分問題なく動くと思います。ご参考まで。
なお、最終版シートには転記するデータの部番号の記入欄が必ずあることが前提となっています。もしもない場合があれば、その場合は転記できません。このコードでは、そのような転記出来なかったものがあった場合でも、直ちには分かりませんので、念のため申し添えます。
Option Explicit
Sub sample3()
'分析中シートの品目コードに対応する最終版シートの品目コードの表のセル範囲で検索して転記する
Dim sheetA As Worksheet
Dim sheetB As Worksheet
Dim blnkRowCount As Integer
Dim i As Long
Dim colBData As String
Dim colCData As String
Dim strItemTitle As String
Dim topRowNum As Long
Dim endRowNum As Long
Dim tgtTitleRow As Long
Dim tgtTopRowNum As Long
Dim tgtEndRowNum As Long
Dim j As Long
Dim k As Long
Dim strData As String
Dim buNum As Long
Set sheetA = シートを指定する("分析中シートの適当なセルをクリックしてください。")
If sheetA Is Nothing Then
MsgBox "キャンセルされたので、終了します。"
Exit Sub
End If
Set sheetB = シートを指定する("最終版シートの適当なセルをクリックしてください。")
If sheetB Is Nothing Then
MsgBox "キャンセルされたので、終了します。"
Set sheetA = Nothing
Exit Sub
End If
' a = .Cells(4, 1).End(xlDown).Row
With sheetA
blnkRowCount = 1
i = 1
Do While blnkRowCount <= 10
colBData = .Cells(i, 2).Value
colCData = .Cells(i, 3).Value
If blnkRowCount > 0 And colBData <> "" And colCData <> "" Then
blnkRowCount = 0
strItemTitle = Left(colBData, 6) '分析中シートのB列のタイトル冒頭6桁の番号を取得
topRowNum = i ; 1 '分析中シートのタイトル直下の行番号を取得
endRowNum = .Cells(i, 1).End(xlDown).Row '分析中シートのタイトル以下の表の連続する記入済み行の最下行を取得
With sheetB
tgtTitleRow = .Range(.Cells(1, 2), .Cells(100, 2)).Find(What:=strItemTitle,LookAt:=xlPart).Row '最終版シートの対応するB列のタイトル行番号を取得
tgtTopRowNum = tgtTitleRow ; 1 '最終版シートの対応するタイトル行直下の行番号を取得
tgtEndRowNum = .Cells(tgtTitleRow, 1).End(xlDown).Row '最終版シートの対応するタイトル以下の表の連続する記入済み行の最下行を取得
For j = topRowNum To endRowNum
strData = sheetA.Cells(j, 3).Value '分析中シートのコメント欄の値を取得
If strData <> "" Then
buNum = sheetA.Cells(j, 1).Value '対応する部番号を取得
For k = tgtTopRowNum To tgtEndRowNum '最終版シートの対応する表中の部番号を検索して一致する場合はstrDataをコメント欄に記入
If .Cells(k, 1).Value = buNum Then
.Cells(k, 3).Value = strData
Exit For
End If
Next k
End If
Next j
End With
i = endRowNum
ElseIf blnkRowCount = 0 And colBData = "" And colCData = "" Then
blnkRowCount = 1
ElseIf blnkRowCount > 0 And colBData = "" And colCData = "" Then
blnkRowCount = blnkRowCount ; 1
Else
'このケースは有り得ない
End If
i = i ; 1
Loop
End With
Set sheetA = Nothing
Set sheetB = Nothing
MsgBox "fini"
End Sub
Private Function シートを指定する(ByVal strMsg As String) As Worksheet
'シートを指定するInputBoxを表示して、指定されたシートを返す。
'strMsg=メッセージ（InputBoxで表示されるメッセージ）
Dim myRetVal As Variant
On Error Resume Next
Set myRetVal = Application.InputBox(strMsg, Type:=8)
If myRetVal Is Nothing Then
Err.Number = 0
Exit Function
Else
Set シートを指定する = myRetVal.Worksheet
Set myRetVal = Nothing
End If
On Error GoTo 0
End Function
2022年7月26日火曜日 1:29
佐祐理さん：
Powerと聞いて、今思い出しました。
わたしはPowerPivotは使っています。最初はエクセルの既存の行数以上のデータベースを扱うのに必要だと思って始めたのですが、結局そこまで大きいデータベースは使わないことがわかって、PowerPivotをただのPivot Tableとして使っているという、何がお得なのかわからない使い方をしています。 それでも慣れたPowerPivotですので、Excelのバージョンが上がるたびに『どうかPowerPivotがなくなりませんように…』と祈ってます。なお外部からデータを取り込むような使い方はしたことがありません。本当は式などを組み入れることができるのでもっとしっかり活用したほうがいいんですよね・・・。マイクロソフトが親切にも無料で提供してくれているというのに・・・もったいない・・・。
LiLi803
2022年7月26日火曜日 1:45
Shasano様：
コメントをありがとうございます。
不思議なことでできる時とエラーメッセージが出る時があるのです。
Find("635000"、LookAt:=xlPart)
そうか！ こういう風にすれば２つの会社で会計項目のTextでスペースが一個多いとか、ハイフンがあるなしは関係なくなりますね。会計項目番号は２つの会社で絶対一致です。 その６桁の番号にスペースが一個多いとかハイフンがあるかないかなどの問題はあり得ません。
最後の会計項目では確かに最終行は見つけられません。 よって今までは一番下に来る会計項目だけは
LastRow = Cells(Rows.Count, 1).End(xlUp).Row で取得して、最終行にしていました。その場合は-2ではないですね。何といっても一番下に来る会計項目の下は真っ白の空白行が延々と続くので何からも-2はできません・・・。
本当にお恥ずかしいです。 ともかく動くことだけを追求しているのでわたしのコードは重複作業が多く、信じられないほど効率が悪いのです。
LiLi803
2022年7月26日火曜日 2:29
KokemomoYamamomo様：
こんにちわです。
コメントをありがとうございました。
2時間、コードを見続けさせていただきました。
恥ずかしながらわたしはDo WhileもFor Nextの入れ子も自力ではまったくコードが書けません。 ですから最初に見たときは『何がわからないのかわからない』『自分の表に合わせてコードを修正する方法がわからない』状態でした。
でも2時間かけて一行一行見ました。まずわたしは自分の表に合わせてコードを変える部分と、そのまま使用すればよい部分を見極めることが必要だと思いました。そう考えるとコードを変える部分は限定されていることが少しわかってきました。分析シートと最終版シートで活用するのは３列のみです。行数は縦長ですが、列は３列と限定されているので落ち着いて一つ一つ変える部分を見極めようと思います。
分析中シートと最終版シートの空白行は両方とも１０以下です。もうちょっと正確に２つの表を見て、最終的にいくつ以下にするのがベストか見極めてコードを変えていきます。
最終版シートには転記するデータの部番号の記入欄が必ずあります。必ず最終確認します。
１つ質問なのですが：
分析中シートと最終版シートは全く同じ１つのエクセルファイルにあります。隣同士のシートです。その場合Functionの部分を使わなくてもいいですか？
自分で必ずしっかりと結果を確認します。 必ず責任をもってちゃんと見ます。
ただ、わたしが使えるようになるまで（もしそれが可能なら）相当の時間がかかると思います。
実際取り掛かるのは週末になると思います。
時間はかかると思いますが、必ず報告いたします。このスレッドは引き続きオープンのままにさせていただきたいと思います。
余計なお世話なんてとんでもない！非常に感謝しています。
わたしはVisual Basicを今より少しでも上達するために、どんなトレーニングでも受けるべきなのです。Visual Basicを学ぶためなら苦労は厭わないです。自分にとって難しければ難しいほど、わたしは新しいことを学びます。
そのためなら何冊の実用本を読んでもよいのですが、どんな教材を使えばよいのかさっぱりわかりません。Visual Basicの実用本だけなら15冊ぐらい持っているのですが、それでもDo Loopも入れ子も書けないので、これはわたしの地頭のせいだと思っています。 ただ、努力だけは決して止めません。わたしの仕事をこんなに助けてくれるVisual Basicが大好きなのです。魔法だと思っています。
本当にありがとうございます。
LiLi803
2022年7月26日火曜日 3:00
LiLi803さん、今日は。
コメントありがとうございます。
確かに、LiLi803さんのリクエスト以上の色々を盛り込んでいるので、余計なお世話で、時間を掛けさせてしまって申し訳ありません。
余計なお世話項目は、次の通りです。
１．分析中シートは個別の商品アイテムごとに作成されるのでしょうけれど、1つの商品アイテムだけでなく、複数の商品アイテムについて1つの分析中シートに、数行の空白行を開けて、縦方向に順番に作成する場合もあるのかな、と考えました。このため、分析中シートを1行目から下にたどって行って、表タイトルに出くわすたびにその表の商品アイテムの番号に応じた最終版シートの相当する表タイトルをFindして、データを転記するようにしました。ただし、分析中シートに1つの商品アイテムの表しかなくても勿論正しく動作します。
２．シートを指定するFunction。分析中シートも最終版シートも同じブックのシートであれば、最初にご提示したコードの様に
「Set sheetA = ThisWorkbook.Worksheets("分析中")」
を使えばよろしいかと思います。
小生もそうですが、ご自分で理解して納得して使うことが大事だと思います。ご自分で理解して、ご自分の分かりやすいように修正して使われることが、今後何か修正を加えなければならないことが起こった場合などに、的確に対応できる基礎となると思います。ご自由に修正して、いろいろ試してみて下さい。
それから、shasanoさん、アドバイスを利用させていただきました。ありがとうございました。
2022年7月26日火曜日 9:29
KokemomoYamamoto様：
こんばんわ。
まだ最初のトライで完成してません。これからずっとコードを点検していきます。
以下のコードだとエラーは出ないのですが、２番目の会計項目グループのコメント列だけに各種いろいろな会計番号のコメントが凝縮されて転記されてしまいます。なぜか部番号だけは一致しています。
コードは日本語が打てない事情があって英語のコメントを入れています。
実際の表では部番号はB列、会計項目番号はC列、コメントは最終行（LC）から５マイナスした列にあります。
End rowを取得するためにC列（3）を選んだのはC列のEnd Rowには小計行があるからです。
そう言えば実際の表はわたしのサンプルと違う部分が多々あることに気が付きました。すみません・・・。C列の最後は小計行でB列の部番号は空欄ですとか、C列の会計項目番号は部番号の一番上の行の、そのまた一つ上の行から始まっているなどです。会計項目グループごとにC列では空欄は一行ですが、B列の部番号を見ると３行空白です。そして最終版のコメント欄は空欄ではなく、いろいろなコメントが最初から入力されています。 分析シートからのValueを上書きするのでよいかと思いましたが、そういうわけにはいかないのかもしれません。
実際は以下のような仕様でした。
引き続き点検してみます。 そもそも実際の表を表示しなかった一番の問題です。本当にすみません。
最終的にできなかったら当初考えていた会計項目グループごとに別々にループを回す方法も考えます。
Sub TENKI_DO_WHILE_V1()
'Transfer comment from "Analyze" sheet to "Final" sheet in a comment column which matches both Account Number and Department Number.
Dim sheetA As Worksheet 'sheetA = Analyze Sheet = Copy from
Dim sheetB As Worksheet 'sheetB = Final Sheet = Copy to/Transfer to
Dim LC As Long 'Last column number of Sheet A and Sheet B
Dim blnkRowCount As Integer 'BlankRowCount = To count blank row.
Dim i As Long
Dim colBData As String ' "Analyze" sheet Column B string = Account Number
Dim colCData As String ' "Analyze" sheet Column C string = Comment
Dim strItemTitle As String ' to get Account number in "Analyze" sheet such as 635000
Dim topRowNum As Long '"Anaylze" sheet top Row number
Dim endRowNum As Long '"Analyze" sheet end Row Number
Dim tgtTitleRow As Long ' "Final" Sheet Account Number
Dim tgtTopRowNum As Long ' "Final" Sheet Top row
Dim tgtEndRowNum As Long ' "Final" Sheet end row
Dim j As Long
Dim k As Long
Dim strData As String
Dim buNum As Long ' Department Number
Set sheetA = ThisWorkbook.Worksheets("Analyze")
Set sheetB = ThisWorkbook.Worksheets("Final")
With sheetA ' "Analyze" sheet = Copy from/Transfer from
LC = .Cells(9, Columns.Count).End(xlToLeft).Column
blnkRowCount = 1
i = 11
Do While blnkRowCount <= 10
colBData = .Cells(i, 3).Value
colCData = .Cells(i, LC - 5).Value
If blnkRowCount > 0 And colBData <> "" And colCData <> "" Then
blnkRowCount = 0
strItemTitle = Left(colBData, 6) 'Get first 6 string from Left in Account Number Title on "Analyze" Sheet = Account number
topRowNum = i ; 1 'Get first row number of records on "Analyze" Sheet = Header row number ; 1
endRowNum = .Cells(i, 3).End(xlDown).Row ' Get last row number of record on "Analyze" under an account number group
With sheetB '"Final Sheet" = Transfer to
tgtTitleRow = .Range(.Cells(11, 3), .Cells(498, 3)).Find(What:=strItemTitle, LookAt:=xlPart).Row 'Get row number of account number on "Final" Sheet
tgtTopRowNum = tgtTitleRow ; 1 ''Get first row number of records on "Final" Sheet = Header row number ; 1
tgtEndRowNum = .Cells(tgtTitleRow, 3).End(xlDown).Row '' Get last row number of record on "Final" under an account number group
For j = topRowNum To endRowNum
strData = sheetA.Cells(j, LC - 5).Value 'Get comment value from "Analyze sheet
If strData <> "" Then
buNum = sheetA.Cells(j, 2).Value 'Get Department number from "Analyze" Sheet
For k = tgtTopRowNum To tgtEndRowNum 'If Account number and Department number mathches transfer value from "Analyze" Sheet to "Final Sheet"
If .Cells(k, 2).Value = buNum Then
.Cells(k, LC - 5).Value = strData
Exit For
End If
Next k
End If
Next j
End With
i = endRowNum
ElseIf blnkRowCount = 0 And colBData = "" And colCData = "" Then
blnkRowCount = 1
ElseIf blnkRowCount > 0 And colBData = "" And colCData = "" Then
blnkRowCount = blnkRowCount ; 1
Else
'This does not apply
End If
i = i ; 1
Loop
End With
Set sheetA = Nothing
Set sheetB = Nothing
MsgBox "fini"
End Sub
LiLi803
2022年7月26日火曜日 10:24
LiLi803さん、今晩は。
まず、表示された画像がAnalyzeのものなのか、Finalのものなのか、それとも体裁(項目等のセルの位置関係)はAnalyzeもFinalも共通なのか、良く分かりません。教えてください。(以前の投稿で、分析中は1つの表しか無いように理解しておりますので、ありゃっ？と思った次第です。)
次に、この体裁では、列番号を置き換えても、うまく動作しません。というのは、例えば食材１のタイトル行のC列は「634200-食材１」の記入がありますが、コメント列(LC-5)列は空欄となっています。以前ご提示されたシートとはこの点が決定的に異なっておりますので、小生がご提示したコードの列番号を変更してもうまく動作しません。
「If blnkRowCount > 0 And colBData <> "" And colCData <> "" Then」が、「会計項目グループ」と言っている一塊の表のタイトル行(最上行)か否かを判定するIF文なわけで、以前ご提示された画像のシートでは、タイトル行ですとTrueを返すので、以下の処理が実行されるわけです。ところが、今回ご提示された画像のシートでは、タイトル行でもcolCData=""ですので、このIF文はFalseを返すこととなり、以下の処理は実行されません。このタイトル行か否かを判定するIF文について修正する必要があります。
ちょっと先走って修正を考え始めましたが、やはり、AnalyzeとFinalのシートの正確な情報を得なければ砂上の楼閣となってしまいますので(例えば、最初の方の i=11 はAnalyzeも今回提示された画像と同じだからかな？)、とりあえず、回答を待ちたいと思います。
2022年7月27日水曜日 0:02
KokemomoYamamomo様
こんにちわ！
先に貼ったのが分析中(Analyze)=sheetAなのか最終版(Final)=sheetBなのかまったく触れていなくてすみません；；；！
いきなり一枚になったらそれは困りますよね。 すみません。以下にSheetAとSheetBのサンプル仕様を貼ります。SheetB（最終版）はもう転記が済んだものとして表示しています。
分析中(Analyze)=sheetA は以下
最終版(Final)=sheetB は以下 （この図はもう転記が済んだものとしてあります。）
いくつかの固定条件
●Analyze(分析中シート＝sheetA）とFinal（最終版シート＝sheetB)はどちらも「会計項目グループ」がC列の11行目から始まる。 部番号は両方ともB列。コメントは両方とも最終列ー5
●最終列（先のメイルで行と言ってしまいました。すみません）を9行から取得するのは他の行を取ると最終列の後にも無視してよいあまりここでは意味のない数字の記入があるから。 ９行目でないとコメント列を指定するすっきりした最終列がとれないのです。
●「会計項目グループ」全部で10項目。サンプルでは省略して３グループしか載せていません。この会計グループの部番号がAnalyzeシートとFinalシートで減ったり、増えたりして行数が変わります。 よってコメントの位置がずれます。しかし水色の行が示す合計行の下は常に１行空白です。例外は会計項目グループの最後です。 最後の会計項目の水色の合計の次に２行空白を開けて全部の合計が示されます。 しかもそれから6つの空白行を経て、またここでは不必要の数字の羅列が始まります。
全部の合計（オレンジ色の行）のC列のStringは常に”合計 その他の在庫”なので、このStringまで作業をするという考え方もあるのかなと思います。 Do Whileなら最終行を取得する必要はないのかもしれません。
●先にも書きましたが、Finalシートのコメント欄は完全空白ではありません。Finalシートを出力した時に最初からコメントが入っています。Analyzeシートから転記するときにFinalシートにもとからあったコメントは残っていてもかまいません。転記はValueだけで、色などのスタイルはFinalシートに持っていきたくありません。
こんなめちゃくちゃな表ですみません。見れば見るほどきちっとしたデータベースからは程遠い仕様ですよね。
だから会計項目ごとに最上行と最下行の数を別々に変数に入れて１０回別々のループを回す・・・というのもやはり保険として考えています。endrowの取り方ですとか、Findの一部一致、Do Whileは最終行を変数に入れなくてよいとか目から鱗が落ちる知識をたくさん得ることができました。今までは、それの10倍ぐらい回りくどい方法でコードを実施していました。
本当に勉強になっております。 ありがとうございます。
LiLi803
2022年7月27日水曜日 4:12 | 1 票
LiLi803さん、今日は。
情報提供ありがとうございます。
１．ご提示されたAnalyzeとFinalを見ると、AnalyzeにはあるけれどFinalには無い部番号が見られます。場合によっては、検索しても部番号が見つからず、転記できない場合があるかもしれないと、危惧します。ですので、その対応を織り込みました。
なお、問題が無いことを確認するために、このコードのうち転記する部分を削除したものを作成して、これを実行して、問題が無いことを確認したうえで、転記する部分がそのままのこのコードを実行して転記する、と言うようにしたらトラブルが無くて良いのではないかと思います。
２．「Finalシートを出力した時に最初からコメントが入っています。」とのことですが、コメント記入欄に既にコメントが記入されている場合の対応も考えておく必要がありますね。一応、上書きと追記のいずれかを選択できるようにしました。
３．仕事でお使いになるのでしょうから、小生だったら、転記できたレコードは、色を付けるとか「転記済み」とのコメントを記すとかするところですが、ちょっと御節介も;きすぎかなと思うので、必要だと思ったらいろいろ調べてご自分でやってみてください。
ということで、コードを次に提示します。
Option Explicit
Sub TENKI_DO_WHILE_V1_remake()
'Transfer comment from "Analyze" sheet to "Final" sheet in a comment column which matches both Account Number and Department Number.
Dim sheetA As Worksheet 'sheetA = Analyze Sheet = Copy from
Dim sheetB As Worksheet 'sheetB = Final Sheet = Copy to/Transfer to
Dim LC As Long 'Last column number of SheetA and SheetB
Dim blnkRowCount As Integer 'BlankRowCount = To count blank row.
Dim i As Long
Dim colBData As String ' "Analyze" sheet Column B string = Account Number
Dim colCData As String ' "Analyze" sheet Column C string = Account Name
'Dim colCData As String ' "Analyze" sheet Column C string = Comment
Dim colCmntData As String ' "Analyze" sheet Column C string = Comment
Dim strItemTitle As String ' to get Account number in "Analyze" sheet such as 635000
Dim topRowNum As Long '"Anaylze" sheet top Row number
Dim endRowNum As Long '"Analyze" sheet end Row Number
Dim tgtTitleRow As Long ' "Final" Sheet Account Number
Dim tgtTopRowNum As Long ' "Final" Sheet Top row
Dim tgtEndRowNum As Long ' "Final" Sheet end row
Dim hitFlag As Boolean '該当する部番号があったか否かの判定用変数
Dim myRetVal As Variant
Dim j As Long
Dim k As Long
Dim strData As String
Dim buNum As Long ' Department Number
Set sheetA = ThisWorkbook.Worksheets("Analyze")
Set sheetB = ThisWorkbook.Worksheets("Final")
With sheetA ' "Analyze" sheet = Copy from/Transfer from
' LC = .Cells(9, Columns.Count).End(xlToLeft).Column
LC = .Cells(9, .Columns.Count).End(xlToLeft).Column '厳密にはColumnsの前に"."が有った方が良い（；シートが特定される）
blnkRowCount = 1
i = 11 '<<★Is this RowNumber topTitle's RowNumber of Analyze Sheet?
Do While blnkRowCount <= 4
' colBData = .Cells(i, 3).Value
colBData = .Cells(i, 2).Value
colCData = .Cells(i, 3).Value
' colCData = .Cells(i, LC - 5).Value
colCmntData = .Cells(i, LC - 5).Value
' If blnkRowCount > 0 And colCData <> "" And colCData <> "" Then
If blnkRowCount > 0 And colCData <> "" And colBData = "" Then
'直前が空白行でC列セルが空でなくB列セルが空の場合；会計項目グループのタイトル行の可能性がある
blnkRowCount = 0
If IsNumeric(Left(colCData, 6)) = True Then '「If IsNumeric(Left(colCData, 6)) Then」でも良い
'colCDataの左6文字が数字の場合;colCDataは会計項目グループのタイトルなので、以下の処理を実行する
' strItemTitle = Left(colCData, 6) 'Get first 6 string from Left in Account Number Title on "Analyze" Sheet = Account number
strItemTitle = colCData '；合計行にも番号があるので、部分一致ではだめ
topRowNum = i ; 1 'Get first row number of records on "Analyze" Sheet = Header row number ; 1
endRowNum = .Cells(i, 3).End(xlDown).Row ' Get last row number of record on "Analyze" under an account number group
'「合計」の行であることに留意のこと。
With sheetB '"Final Sheet" = Transfer to
tgtTitleRow = .Range(.Cells(11, 3), .Cells(498, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row 'Get row number of account number on "Final" Sheet
'全部一致に変更
tgtTopRowNum = tgtTitleRow ; 1 ''Get first row number of records on "Final" Sheet = Header row number ; 1
tgtEndRowNum = .Cells(tgtTitleRow, 3).End(xlDown).Row '' Get last row number of record on "Final" under an account number group
'「合計」の行であることに留意のこと。
For j = topRowNum To endRowNum - 1 'endRowNumは「合計」の行なのでその1行上の行まで繰り返すので、「-1」
strData = sheetA.Cells(j, LC - 5).Value 'Get comment value from "Analyze sheet
If strData <> "" Then
buNum = sheetA.Cells(j, 2).Value 'Get Department number from "Analyze" Sheet
hitFlag = True
For k = tgtTopRowNum To tgtEndRowNum - 1 'If Account number and Department number mathches transfer value from "Analyze" Sheet to "Final Sheet"
'tgtEndRowNumは「合計」の行なのでその1行上の行まで繰り返すので、「-1」
If .Cells(k, 2).Value = buNum Then
If .Cells(k, LC - 5).Value = "" Then
.Cells(k, LC - 5).Value = strData
Else
myRetVal = MsgBox("コメント記入欄に記事が記入されています。" & vbCrLf & _
"上書きと追記のうち、上書きしますか？", vbYesNo ; vbQuestion)
If myRetVal = vbYes Then
.Cells(k, LC - 5).Value = strData '上書きする。既存の記事は無くなる
Else
.Cells(k, LC - 5).Value = .Cells(k, LC - 5).Value & "。 " & strData '既存の記事の後に"。 "と続いてコメントを記入する
End If
End If
hitFlag = False
Exit For
End If
Next k
If hitFlag = True Then '「If hitFlag Then」でも良い
MsgBox "次のコメントは、対応する部番号がFinalシートに無いので、転記できませんでした。" & vbCrLf & _
"会計項目グループの番号 = " & strItemTitle & vbCrLf & _
"部番号 = " & CStr(buNum) & vbCrLf & _
"コメント = " & strData, vbOKOnly ; vbExclamation
End If
End If
Next j
End With
i = endRowNum
Else
'colCDataの左6文字が数字でない場合；会計項目グループのタイトル行ではないので、何もしない
End If
' ElseIf blnkRowCount = 0 And colCData = "" And colBData = "" Then '次のElseIf文で同様の処理ができるので削除
' blnkRowCount = 1
' ElseIf blnkRowCount > 0 And colCData = "" And colBData = "" Then
ElseIf colCData = "" And colBData = "" Then
blnkRowCount = blnkRowCount ; 1
ElseIf colCData = "" And colBData <> "" Then
'B列に記入があるがc列には無い場合；何もしない
blnkRowCount = 0 'なくてもこのシートの例では実質的に問題は生じないが、正確ではないので追加。
Else 'This does not apply 又は処理対象外なので何もしない
blnkRowCount = 0 'なくてもこのシートの例では実質的に問題は生じないが、正確ではないので追加。
End If
i = i ; 1
Loop
End With
Set sheetA = Nothing
Set sheetB = Nothing
MsgBox "fini"
End Sub
修正したコードは、分かりやすいようにコメント行にして残しておきましたが、ちょっとごちゃごちゃし過ぎたかもしれません。
なお、シートを指定するFunctionは同じなので省略しておりますが、同じモジュールに置いておく必要がありますので、念のため申し添えます。←間違い。シートを指定するFunctioは必要ありませんでした。ごめんなさい。
※ 何もしない選択肢に、正確には blnkRowCount=0 が必要であることに気がつきましたので、追記しました。この提示されたシートの例では特段問題は生じなかったと思いますが、念のため。
2022年7月27日水曜日 5:03 | 1 票
すでに KokemomoYamamomo さんが何度もコードを提示されていますし、LiLi803 には余計な混乱をさせてしまうかもですが、B 列と C 列の組み合わせは同一シートではユニークなのでしょうか？
7/24 23:26 や 7/25 2:02 の図ではそうなっていませんが、もしユニークなのであれば、かつ例えば Analyze では「飲み物A」が Final では「飲物 Ａ」になっていたりすることがなければ、会計項目など気にせずに「連想配列」を利用して非常に簡潔にできそうな気がしますが…。
2022年7月28日木曜日 2:29
KokemomoYamamomo様：
こんにちわです！
RemakeのCodeを本当にありがとうございました。
一番下にコメントを英語にしたものをコピーしました。
箇条書きでお伝えすることをお許しください。
●コメントを英語にした以外、変更したところは空白行を<=4から<=10にしました。
●希望した通りの転記になりました。AnalyzeシートからFinalシートへ一致した会計項目番号と部番号のコメントが一致した行に転記されました！！ありがとうございます！
●tgtTitleRow = .Range(.Cells(11, 3), .Cells(498, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row の部分ですが、498と手入力の数字が入ってます。これは最終的に変数で求めるように努力します。
●はじめはFinal シートのコメントを削除してからテストしました。 しかし最終目的は上書き一択です。追記ということはありません。そして対応する部番号がAnalyzeシートにはあり、Final Sheetになかった場合、Analyzeシートにあったコメントは転記せずにただ無視するということで作業をしております。
よって大変恐縮なのですが、コード全体から上書きをするか、追記をするかという選択を確認するコードとAnalyze シートにはあり、Final Sheetにはなかった場合『転記できませんでした』という報告をしてくれるコードを削除することはできますか？
自分でもコメントアウトしようと試みました。でもお恥ずかしいことにいったいどこからどこをコメントアウトすれば上記の２つのコードをコメントアウトできるのかわかりません。恐れ入りますが削除したバージョンをいただけますでしょうか？ 上書きは80回ぐらいOKをクリックしなくてはならないのでやはり上書きがデフォの場合、選ばなくてもよいかな・・・と思います。
以下、わたしのコメントアウトの仕方が間違っています。 重ね重ねすみません。 ありがとうございます。
Sub TENKI_DO_WHILE_V1_remake2()
'Transfer comment from "Analyze" sheet to "Final" sheet in a comment column which matches both Account Number and Department Number.
Dim sheetA As Worksheet 'sheetA = Analyze Sheet = Copy from
Dim sheetB As Worksheet 'sheetB = Final Sheet = Copy to/Transfer to
Dim LC As Long 'Last column number of SheetA and SheetB
Dim blnkRowCount As Integer 'BlankRowCount = To count blank row.
Dim i As Long
Dim colBData As String ' "Analyze" sheet Column B string = Account Number
Dim colCData As String ' "Analyze" sheet Column C string = Account Name
'Dim colCData As String ' "Analyze" sheet Column C string = Comment
Dim colCmntData As String ' "Analyze" sheet Column C string = Comment
Dim strItemTitle As String ' to get Account number in "Analyze" sheet such as 635000
Dim topRowNum As Long '"Anaylze" sheet top Row number
Dim endRowNum As Long '"Analyze" sheet end Row Number
Dim tgtTitleRow As Long ' "Final" Sheet Account Number
Dim tgtTopRowNum As Long ' "Final" Sheet Top row
Dim tgtEndRowNum As Long ' "Final" Sheet end row
Dim hitFlag As Boolean 'Variable to eveluate if applicable Department number exists or nor数
Dim myRetVal As Variant
Dim j As Long
Dim k As Long
Dim strData As String
Dim buNum As Long ' Department Number
Set sheetA = ThisWorkbook.Worksheets("Analyze")
Set sheetB = ThisWorkbook.Worksheets("Final")
With sheetA ' "Analyze" sheet = Copy from/Transfer from
' LC = .Cells(9, Columns.Count).End(xlToLeft).Column
LC = .Cells(9, .Columns.Count).End(xlToLeft).Column 'This will be used to get a last column number for current month. "" before Columns.
blnkRowCount = 1
i = 11 '<<* this RowNumber topTitle's RowNumber of Analyze Sheet?
Do While blnkRowCount <= 10
' colBData = .Cells(i, 3).Value
colBData = .Cells(i, 2).Value
colCData = .Cells(i, 3).Value
' colCData = .Cells(i, LC - 5).Value
colCmntData = .Cells(i, LC - 5).Value
' If blnkRowCount > 0 And colCData <> "" And colCData <> "" Then
If blnkRowCount > 0 And colCData <> "" And colBData = "" Then
'If there is a value in Column C immedicate after blank row but empty in Column B, it is possible that the cell contains an Account Number title
blnkRowCount = 0
If IsNumeric(Left(colCData, 6)) = True Then '-If IsNumeric(Left(colCData, 6)) Then can be also used.
'If colCData starts with 6 numbers: colCData is Account number of account group, run following
' strItemTitle = Left(colCData, 6) 'Get first 6 string from Left in Account Number Title on "Analyze" Sheet = Account number
strItemTitle = colCData 'Since total row has a number, finding partial string does not work.
topRowNum = i ; 1 'Get first row number of records on "Analyze" Sheet = Header row number ; 1
endRowNum = .Cells(i, 3).End(xlDown).Row ' Get last row number of record on "Analyze" under an account number group
'To confirm it's a total row.
With sheetB '"Final Sheet" = Transfer to
tgtTitleRow = .Range(.Cells(11, 3), .Cells(498, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row 'Get row number of account number on "Final" Sheet
'Change from Partial to Whole match.
tgtTopRowNum = tgtTitleRow ; 1 ''Get first row number of records on "Final" Sheet = Header row number ; 1
tgtEndRowNum = .Cells(tgtTitleRow, 3).End(xlDown).Row '' Get last row number of record on "Final" under an account number group
'To confirm it's a total row.
For j = topRowNum To endRowNum - 1 'Since endRowNum is a total row, -1
strData = sheetA.Cells(j, LC - 5).Value 'Get comment value from "Analyze sheet
If strData <> "" Then
buNum = sheetA.Cells(j, 2).Value 'Get Department number from "Analyze" Sheet
hitFlag = True
For k = tgtTopRowNum To tgtEndRowNum - 1 'If Account number and Department number mathches transfer value from "Analyze" Sheet to "Final Sheet"
'tgtEndRowNum is total row, repeat to -1 row.
If .Cells(k, 2).Value = buNum Then
If .Cells(k, LC - 5).Value = "" Then
.Cells(k, LC - 5).Value = strData
Else
myRetVal = MsgBox("Comment Already in" & vbCrLf & _
"Do you want to override", vbYesNo ; vbQuestion)
If myRetVal = vbYes Then
.Cells(k, LC - 5).Value = strData 'This to override. Existing comment will be cleared.
Else
.Cells(k, LC - 5).Value = .Cells(k, LC - 5).Value & "。 " & strData 'Enter comment after ?
End If
End If
hitFlag = False
Exit For
End If
Next k
If hitFlag = True Then 'If hitFlag Then can be used, too
MsgBox "Could not transfer as there was no dept number in final" & vbCrLf & _
"Account Number = " & strItemTitle & vbCrLf & _
"Dept Number = " & CStr(buNum) & vbCrLf & _
"Commentg = " & strData, vbOKOnly ; vbExclamation
End If
End If
Next j
End With
i = endRowNum
Else
'If colCData does not start with 6 numbers, it is not an Accont Number. Do nothing.
End If
' ElseIf blnkRowCount = 0 And colCData = "" And colBData = "" Then 'Delete as Elseif can do the same actions
' blnkRowCount = 1
' ElseIf blnkRowCount > 0 And colCData = "" And colBData = "" Then
ElseIf colCData = "" And colBData = "" Then
blnkRowCount = blnkRowCount ; 1
ElseIf colCData = "" And colBData <> "" Then
'If Column B has value but not in Column C. Do nothing.
blnkRowCount = 0 'Not required but entered for accuracy.
Else
'Do nothing as this does not apply
blnkRowCount = 0 'Not required but entered for accuracy.
End If
i = i ; 1
Loop
End With
Set sheetA = Nothing
Set sheetB = Nothing
MsgBox "fini"
End Sub
LiLi803
2022年7月28日木曜日 3:00
Shasano様：
コメントありがとうございます。
7/24 23:26 や 7/25 2:02 の図はサンプルとして作成しました。実際の表とはずいぶんかけ離れていて、データの記入が正確でないところがあるかもしれず申し訳ございません。恐れ入りますが、そちらのサンプルのほうではなく、以下の実際のレポートでご説明させてください。
以下のAnalyzeシートとFinalシートにおいてB列とC列の組み合わせはユニークかつ同一です。Analyzeシートで「飲み物A」がFinalシートで「飲み物 A」になるということは決してありません。C列とB列の横並びのValueはAnalyzeシートとFinalシートでまったく鏡のように同一です。
問題はFinalシートを出力すると、Analyzeシートから部番号が減ったり、増えたりして行の位置が変わってしまうことだけです。だからAnalyzeシートからC列をガーっとコピーしてFinal シートにペタッと貼り付けることができません。コメントが全然違う部番号に貼れてしまいます。
ですからVisual Basicに考えてもらおうと思いました。 Analyzeシートの部番号は面倒なことに会計項目番号別に塊のグループを10個作っています。 Visual BasicにAnalyzeシートのC列のコメントが記入されている行の会計項目番号と部番号のコンボを覚えてもらい、それをFinalシートの同じ会計項目番号と部番号に転記してほしい・・・というお願いでした。
２年間・・・いや３年間ぐらい考えましたが『絶対無理』とあきらめていました。ここまでVisual Basicが人間の目の代わりになってくれるか確信がありませんでした。
「連想配列」ですか・・。う～ん・・・「配列」があることは知っているのですが、「連想配列」のことは知りません。わたしは普通の「配列」だけでアップアップしているので残念ながら「連想配列」を使うことはできないかもしれません。
残念です・・・。
分析中(Analyze)=sheetA は以下
最終版(Final)=sheetB は以下 （この図はもう転記が済んだものとしてあります。）
LiLi803
2022年7月28日木曜日 6:41 | 1 票
とりあえずちょいと書いてみたのでお試しください。
ある行の B,C 列とコメント列（今回は AA 列）がすべて空白でなければ AA 列のセル値を有効なコメントとして扱う、という前提としています。ひとまずコメントはいっさい入れてませんのであしからず。
Sub 連想配列を使う案()
Dim sheetA As Worksheet: Set sheetA = Worksheets("Analyze")
Dim sheetF As Worksheet: Set sheetF = Worksheets("Final")
Dim colComment As Long: colComment = Cells(9, Columns.Count).End(xlToLeft).Column - 5
Dim comDic As Object
Set comDic = CreateObject("Scripting.Dictionary")
With sheetA
Dim i As Long
For i = 12 To .Cells(Rows.Count, 2).End(xlUp).Row
If .Cells(i, 2) <> "" And .Cells(i, 3) <> "" And .Cells(i, colComment) <> "" Then
comDic(.Cells(i, 2).Value & .Cells(i, 3).Value) = .Cells(i, colComment)
End If
Next
End With
With sheetF
For i = 12 To .Cells(Rows.Count, 2).End(xlUp).Row
If comDic.Exists(.Cells(i, 2).Value & .Cells(i, 3).Value) Then
.Cells(i, colComment) = comDic(.Cells(i, 2).Value & .Cells(i, 3).Value)
End If
Next
End With
End Sub
2022年7月28日木曜日 12:33 | 1 票
今回の投稿の表はデータベースからはほど遠い仕様になっていますが
なお外部からデータを取り込むような使い方はしたことがありません。
誤解されているかもしれませんので補足しますと、PowerQueryは外部のデータも取り込めますが、Workbook内の情報も取り込めます。例えばExcel.CurrentWorkbook()ではWorkbook内のWorksheet一覧がテーブルとして取得できます。もちろん個々のWorksheetもテーブルとして扱えます。
今回の質問内容も適切に構成すれば十分にPowerQueryで処理できると思います。
2022年7月28日木曜日 23:56
Shasano様
ご回答ありがとうございます。
DictonaryのCodeを試させていただきました。初めて使うのでMicrosoft Scripting Runtimeを参照設定しました。
結果、部番号は一致した転記になったのですが、正しい会計項目のグループの下に転記できませんでした。各会計項目グループの中にいろいろな会計項目番号が混合で転記されました。部番号は常に一致していました。
わたしのサンプルのコメントの書き方があまりにも簡略すぎました。下に、コメントが実際どのように記入されているか明記しました。コメントは一番最初に会社名、次に会計項目番号、次に部番号、次に文章というフォーマットになっています。AnalyzeのシートからコメントをFinalシートに転記する場合、コメントをいちいち一致した『会計項目番号』のグループの下の一致した部番号に転記することを目標としております。例えばAnalyzeシートでOCN 634200.833500 文章 というコメントがあったら、Finalシートでも会計項目634200のグループの中の同じ部番号の行に転記するのを目的としています。
この会計項目番号まで一致させなくてはいけないというところに非常に苦労しています。しかも会計項目番号はColumnAにあるのではなく、グループの上に一回だけ表示されているだけです。データベースの形をとっていません。
連想配列について少し調べました。
通常の配列がインデックス番号(添え字）と値のコンボだとします。
連想配列はオブジェクトとしてインデックス番号、キー、値のトリオと考えればよいのでしょうか？
Ifの後の条件としてi,2, i,3, i,AAが空白でないとき・・・はその通りです。その条件が合う時にコメント欄のStringをFinalのコメント欄に転記するのですが、ここに会計項目番号の付随条件を付ければFinalの一致した会計項目番号の下に転記できるのかもしれません。インデックス番号に加えて会計項目番号、部番号、コメントを追加したら4つの要素になってしまいトリオの枠にはいらないのかもしれません。
わたしはとてもマニアックな作業をVBA化しようとしていると思います。すみません。マニアックとは良い意味で使っています。Visual Basicは常にわたしの想像のはるか上をやってくれるのでいくら勉強しても終わりがないです。
分析中(Analyze)=sheetA は以下 もう少し正確に直しました。
最終版(Final)=sheetF は以下 （この図はもう転記が済んだものとしてあります。）もう少し正確に直しました。
LiLi803
2022年7月29日金曜日 0:06
佐祐理様：
ご回答ありがとうございます！
PoweQueryは外部のデータ専門と言うわけではないんですね・・・。ちょっと勘違いしていました。
Excelも使えるなら適応を考えてみます。
インターネットでは『超優秀なのにあまり知られていない機能』となっています。コードを書く必要もないみたいなので、もうちょっと詳しく勉強しようと思います。
ありがとうございます。
LiLi803
2022年7月29日金曜日 2:40 | 1 票
ということはやはり（実際のシートでは）「B 列と C 列の組み合わせは同一シートではユニーク」ではないということですね。
最新添付図の Analyze シートの例えば B12 & C12 が他になければ、それ（結合された文字列）をキーとした配列 comDic の値は AA12 の文字列になります（言うまでもなくコメントがどういう構成の文字列かは don't care です）。
そして Final シートで B 列と C 列を結合した文字列が上のキーと等しい行が「ひとつだけ」あるとすれば、その行の AA 列にコメントが代入されます。 この場合その行がどの会計項目にあろうと don't care です。ですが、それは「ユニーク」であることが大前提です。
2022年7月29日金曜日 2:58
Shasano様：
ご回答ありがとうございます。
おっしゃる通りです。B列&C列がユニークだと間違ったことを言ってしまってすみません。
B列＆C列のペアは同一シートで何回も何回もめちゃくちゃ繰り返されます。
例えばAnalyzeシートの22行目：634000-食材２のB列601000＆C列部番号は、32行目：634400-シーツのB列601000＆C列部番号と寸分違わず同一です。 ただ別の会計項目グループにあるだけです。
ユニークじゃない・・・すみません・・・。(><);;;;
でも逆にユニークな表では使えるということを学びました。 ありがとうございます！
LiLi803
2022年7月29日金曜日 5:50 | 1 票
確かに最新の添付図を見ると B,C 列だけではユニークでないのは明らかですね。
それでも会計項目（の数字 6 桁）も組み合わせればこれは必ずユニークなので、先のコードの With ブロックの外側で会計項目を切り出して連想配列のキーとなる文字列に結合すれば、コードはかなり簡潔にできると思います。
ご所望の VBA 化はひとまず実現できたようなので、興味と時間があればトライしてみてください。
2022年7月29日金曜日 9:25 | 1 票
LiLi803さん、今日は。
先の返信で、シートを指定する関数が必要と、間違ったことを書いてしまいましたので、訂正しておきました。
さて、既存のコメントがあっても上書きのみ実行、かつ、部番号がない場合は転記しない、とのことですので、次の様に訂正すればよろしいかと思います。
2022年7月29日金曜日 9:41 | 1 票
LiLi803さん、今日は。
先の返信で、シートを指定するFunctionが必要だと、間違ったことを書いてしまいましたので、下線を引いて、間違いである旨付記しておきました。不注意で申し訳ありません。
さて、上書きのみを実行する、部番号がない場合はメッセージを表示しないで転記もしない、とのことですので、次の様に修正すればよろしいかと思います。
１．「Dim hitFlag As Boolean 」は不要なので削除
２．「hitFlag = True 」を削除
３．「If .Cells(k, LC - 5).Value = "" Then 」を削除
４．その次の「.Cells(k, LC - 5).Value = strData 」は残す。
５．その次の「Else 」から「Exit For 」までを削除
６．2行置いて、
「If hitFlag = True Then 'If hitFlag Then can be used, too
MsgBox "Could not transfer as there was no dept number in final" & vbCrLf & _
"Account Number = " & strItemTitle & vbCrLf & _
"Dept Number = " & CStr(buNum) & vbCrLf & _
"Commentg = " & strData, vbOKOnly ; vbExclamation
End If 」を削除
以上です。
2022年7月29日金曜日 21:40
KokemomoYamamomo様：
おはようございます。
最終的なコードを一番下に貼らせていただきます。今日初めてコードを貼るアイコンを使いました。でも何の言語を選んでよいのかわからず正しく貼れていなかったら申し訳ございません。
まず、望んだとおりの転記ができたことを心より感謝いたします。合計２０個(一社につき１０個 x 2 社）のLoopを使わなくてすんでホッとしています。Loopを２０個別々に書くのも大変ですが、２０個の別々の会計項目番号別の行番号を取るだけでも気が遠くなる作業です。 KokemomoYamamoto様のコードですと、Ｂ列とＣ列を一気に処理してくれるので会計項目グループ群の島に縛られることがなくものすごい速さで転記ができます。 本当にありがとうございます。
２つの会社別々に走らせてみましたが、会計項目のStringが微妙に違うことが問題にならず処理できました。
一つご質問させていただいてよろしいでしょうか？
前にtgtTitleRow = .Range(.Cells(11, 3), .Cells(498, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row の部分は、498と手入力の数字が入ってました。これを変数にしようと思って、ふと思いました。
この最終行はAnalyze Sheetの最終行なのか、Final Sheetの最終行なのか迷いました。
今のところSheetAであることを仮定してSheetAのendRowNumを使っています。
With sheetB '"Final Sheet" = Transfer to
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'In case it is sheet B
tgtTitleRow = .Range(.Cells(11, 3), .Cells(endRowNum, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row
これで作業は希望通り処理されます。
この変数に変えた部分はSheetA=Analyzeシートであると考えてよろしいでしょうか？
Sub TENKI_DO_WHILE_V6()
'Transfer comment from "Analyze" sheet to "Final" sheet in a comment column which matches both Account Number and Department Number.
Dim sheetA As Worksheet 'sheetA = Analyze Sheet = Copy from
Dim sheetB As Worksheet 'sheetB = Final Sheet = Copy to/Transfer to
Dim LR As Long 'Last column number of SheetA or SheetB??? Get at Column 2
Dim LC As Long 'Last column number of SheetA and SheetB
Dim blnkRowCount As Integer 'BlankRowCount = To count blank row.
Dim i As Long
Dim colBData As String ' "Analyze" sheet Column B string = Department Number
Dim colCData As String ' "Analyze" sheet Column C string = Account Number
'Dim colCData As String ' "Analyze" sheet Column C string = Comment
Dim colCmntData As String ' "Analyze" sheet Column C string = Comment
Dim strItemTitle As String ' to get Account number in "Analyze" sheet such as 635000
Dim topRowNum As Long '"Anaylze" sheet top Row number
Dim endRowNum As Long '"Analyze" sheet end Row Number
Dim tgtTitleRow As Long ' "Final" Sheet Account Number
Dim tgtTopRowNum As Long ' "Final" Sheet Top row
Dim tgtEndRowNum As Long ' "Final" Sheet end row
'Dim hitFlag As Boolean 'Variable to eveluate if applicable Department number exists or nor will not be used as not necessary数
Dim myRetVal As Variant
Dim j As Long
Dim k As Long
Dim strData As String
Dim buNum As Long ' Department Number
Set sheetA = ThisWorkbook.Worksheets("Analyze")
Set sheetB = ThisWorkbook.Worksheets("Final")
With sheetA ' "Analyze" sheet = Copy from/Transfer from
LC = .Cells(9, .Columns.Count).End(xlToLeft).Column
blnkRowCount = 1
i = 11 '<< First Account Number Group starts always from Row 11 in both Analyze sheet and Final sheet.
Do While blnkRowCount <= 10
colBData = .Cells(i, 2).Value 'For Department number column 2
colCData = .Cells(i, 3).Value 'For Account Number column 3
colCmntData = .Cells(i, LC - 5).Value 'For Comment string. LC -5 column
If blnkRowCount > 0 And colCData <> "" And colBData = "" Then
'If there is a value in Column C immedicate after blank row but empty in Column B, it is possible that the cell contains an Account Number title
blnkRowCount = 0
If IsNumeric(Left(colCData, 6)) = True Then '-If IsNumeric(Left(colCData, 6)) Then can be also used.
'If colCData starts with 6 numbers: colCData is Account number of account group, run following
' strItemTitle = Left(colCData, 6) 'Get first 6 string from Left in Account Number Title on "Analyze" Sheet = Account number
strItemTitle = colCData 'Since total row has a number, finding partial string does not work.
topRowNum = i ; 1 'Get first row number of records on "Analyze" Sheet = Header row number ; 1
endRowNum = .Cells(i, 3).End(xlDown).Row ' Get last row number of record on "Analyze" under an account number group
'To confirm it's a total row.
With sheetB '"Final Sheet" = Transfer to
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'in case it is SheetB
tgtTitleRow = .Range(.Cells(11, 3), .Cells(endRowNum, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row 'Get row number of account number on "Final" Sheet
'Change from Partial to Whole match.
tgtTopRowNum = tgtTitleRow ; 1 'Get first row number of records on "Final" Sheet = Header row number ; 1
tgtEndRowNum = .Cells(tgtTitleRow, 3).End(xlDown).Row ' Get last row number of record on "Final" under an account number group
'To confirm it's a total row.
For j = topRowNum To endRowNum - 1 'Since endRowNum is a total row, -1
strData = sheetA.Cells(j, LC - 5).Value 'Get comment value from Analyze sheet
If strData <> "" Then
buNum = sheetA.Cells(j, 2).Value 'Get Department number from "Analyze" Sheet
For k = tgtTopRowNum To tgtEndRowNum - 1 'If Account number and Department number mathches transfer value from "Analyze" Sheet to "Final Sheet"
'tgtEndRowNum is total row, repeat to -1 row.
If .Cells(k, 2).Value = buNum Then
'If .Cells(k, LC - 5).Value = "" Then - Comment out for now as not needed
.Cells(k, LC - 5).Value = strData
End If
Next k
End If
Next j
End With
i = endRowNum
Else
'If colCData does not start with 6 numbers, it is not an Accont Number. Do nothing.
End If
ElseIf colCData = "" And colBData = "" Then 'If both Department number and Account number is empty cells
blnkRowCount = blnkRowCount ; 1
ElseIf colCData = "" And colBData <> "" Then 'If Account number is empty but Department number has a value
blnkRowCount = 0 'Not required but entered for accuracy.
Else
'Do nothing as this does not apply
blnkRowCount = 0 'Not required but entered for accuracy.
End If
i = i ; 1
Loop
End With
Set sheetA = Nothing
Set sheetB = Nothing
MsgBox "fini"
End Sub
LiLi803
2022年7月29日金曜日 21:52
Shasano様
コメントありがとうございます。
そうなんです。会計項目番号と部番号のペアはユニークです。
Finalシートの会計項目番号と部番号を空中で（すみません、イメージです）ペアにしてAnalyzeシートの会計項目番号と部番号のペアに紐づければよいのだと思います。
配列はこれからも勉強し続けます。
実用本を読んでもなかなか身につかないのですが、何か必要に迫られて有効なコードを探し、研究するほうがずっと良いと思いました。連想配列も普通の配列よりもむずかしくてもより便利であると知りました。
たくさんの案、そして貴重なコードをありがとうございました。
LiLi803
2022年7月30日土曜日 0:35 | 1 票
LiLi803さん、お早うございます。
まず、言語は、VBAっていうのはないので、小生はVBが一致する「VB.Net」を選択しています。
次に、tgtTitleRow は、Finalシートの会計項目のタイトル行番号です。したがって４９８はFinalシートの最下行番号となります。
「tgtTitleRow = .Range(.Cells(11, 3), .Cells(endRowNum, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row 」で「endRowNum」としたのは誤り。
topRowNum は、Analizeシートのある会計項目の表の部番号が記入されている行の最上行番号、endRowNumは同じくAnalizeシートの同会計項目の表の部番号が記入されている行の最下行番号です。ご注意！！
sheetBの最下行番号の取得の仕方については、いろいろ調べられたら良いと思います。いろいろあります。例えば、次様なコードも(一例です)。ただし、非表示の場合にうまくいかないとか、いろいろエクセル特有のコードの場合、注意が必要です。小生も余り使いませんので、詳しくなくて、いちいち調べて使う事がある程度です。次の例も、オールマイティなのかどうかは、調べ切っておりませんので、わかりません。
With sheetB
最下行番号 = .UsedRange.Cells(.UsedRange.Cells.Count).Row
End With
以上です。
2022年7月30日土曜日 1:13
KokemomoYamamomo様
おはようございます！
ご回答ありがとうございました。
わたしもVB.NETを使いました。よかった～～～。
訂正を教えてくださってありがとうございました。あやうく間違いの変数を使い続けるところでした。
最終行を求めるコードは複数あって、その場その場で一番最適なコードを使うように努力はしているのですが、洗練されたコードが書けず、いつもどこからかマイナスいくつ・・・みたいな算数のような求め方をしてしまいます。
使っているシートがデータベースでないとき、行が隠れているとき、思いもしないところにデータが入っいた…などの場合、最終行がまったく意図しない値で変数に;納されてしまうことがあって特に気を付けなくてはいけないところだと思います。
今の段階ではまだ最終的ではありません。ひょっとしたら操作に応じてもう少しカスタマイズするかもしれません。今しばらくコードをじっくり勉強させてください。
また戻ってきます。 最終的なコードを貼らせてください。
最終的なコードを貼りたいのは、将来このスレッドを見た私のような方（がいたとしたら）が必ずや『役に立った』と思っていいただけると思うからです。 全部まったく同じ操作をすることは多分ないでしょうが、一部同じようなことをする場合、必ずこのスレッドのヒントが役に立つと固く信じています。 ですから今しばらく引き続き使わせてください。
投票などのためにも必ずまた戻ってまいります。
的確なコードをご指南して下さって本当にありがとうございました。
LiLi803
2022年8月1日月曜日 1:07 | 1 票
今朝になって予定が変わって午前中暇になってしまいました。LiLi803さんまた来られるようですし、乗りかかった船なので先のコードを見直してみました。
- 処理開始行を11からにして会計項目（変数は accountNo にしました）を切り出す処理を追加
- 連想配列のキーは会計項目と部署番号の連結文字列とした（B 列は部番号で決まるのでキーには不要）
- Microsoft Scripting Runtime の参照設定をすることを前提とした宣言文に変更
Sub 連想配列を使う案()
Dim sheetA As Worksheet: Set sheetA = Worksheets("Analyze")
Dim sheetF As Worksheet: Set sheetF = Worksheets("Final")
Dim colComment As Long: colComment = Cells(9, Columns.Count).End(xlToLeft).Column - 5
Dim comDic As Dictionary
Set comDic = New Dictionary
With sheetA
Dim i As Long
For i = 11 To .Cells(Rows.Count, 2).End(xlUp).Row
If .Cells(i, 2) = "" And IsNumeric(Left(.Cells(i, 3), 6)) Then
Dim accountNo As String
accountNo = Left(.Cells(i, 3), 6)
End If
If .Cells(i, 2) <> "" And .Cells(i, 3) <> "" And .Cells(i, colComment) <> "" Then
comDic(accountNo & .Cells(i, 2).Value) = .Cells(i, colComment)
End If
Next
End With
With sheetF
For i = 11 To .Cells(Rows.Count, 2).End(xlUp).Row
If .Cells(i, 2) = "" And IsNumeric(Left(.Cells(i, 3), 6)) Then
accountNo = Left(.Cells(i, 3), 6)
End If
If comDic.Exists(accountNo & .Cells(i, 2).Value) Then
.Cells(i, colComment) = comDic(accountNo & .Cells(i, 2).Value)
End If
Next
End With
End Sub
コメントも無いので分かりづらいかも知れませんが、コードとしてはかなり簡潔になっていると思います（ひょっとして考慮不足があるやもですが）。
2022年8月2日火曜日 2:10
Shasano様：
会計項目を切り出すコードを追加してくださって誠にありがとうございます。
新しいコードでは一つの会計項目の中に混合でまとめて転記されることはなく、Finalシートの一致した会計項目番号のグループの下の、一致した部番号の行にぴったりとそれぞれ転記されました！！ ありがとうございます！
質問をさせていただいてよろしいでしょうか？
Googleの受け売りで申し訳ないのですが、Microsoft Scripting Runtimeの参照設定にチェックボックスを入れると、Excel VBAがCollectionのみならずDictionaryも使えるということで理解しました。その場合、Dictionaryを使うコードがあるエクセルファイルは個別にその都度ツールを開き、Microsoft Scripting Runtimeのボックスにチェックを入れる必要がありますか？
それから・・・
とても大まとめな理解の仕方で申し訳ないのですが、SheetAでの作業は連想配列に変数を;納する作業、SheetBではその変数を正しいセルに転記する作業であると思いました。
わたしが無知なるゆえわからなかったところはDim accountNo as Stringです。 わたしは変数について基本中の基本しか知りません。その限定された知識で、ひとつの変数には一つの変数しか入らないということでした。 accountNoは配列の変数ではありません。しかしcomDic（連想配列）と一緒に使うと、配列でない変数が配列の属性を持って扱うことができるということでしょうか？ それならすごいことなんですが・・・。
LiLi803
2022年8月3日水曜日 1:43
佐祐理様：
いつもお世話になっております。
PowerQueryのことは佐祐理様が教えて下さる前には全く知りませんでした。
ですので、PowerQueryに関する動画を５時間ぐらい見ました。
まず、役立ったことがとても主流ではないのですが、PDFファイルをExcelに取得することが非常に役立ちました。今まで、PDFファイルから直接ExcelにConvertして、役立ったためしは一回もありませんでした。いつもPDFの文字や表が、Excelの一つのセルに長々と全部入力されてしまい、計算も並び替えも何できませんでした。
今回PowerQueryを学んでいたことの一環でPDFをExcelにImportすることができると知って早速やってみました。PDFの表のようなページはExcelシート上でほぼ同じようなきれいな表として取得できてびっくりしました。 今まで手入力でPDFファイルのデータをExcel移し替えてましたが、もうそういうことをする必要がなくなりました。 今までこれを知らなかったなんて、なんて人生を損していたのだろうと思います。
さて、他の使い方ですが、私が使っている複数のデータベースにはすべてのデータベースをつないでくれるユニークなPrimary Keyがありません。例えば帳簿仕分けデータベースと銀行明細のデータベースを一緒にマージしたくても、銀行明細に会社の会計ソフトの会計番号がアサインされてはいないし、帳簿仕分けデータベースに銀行の詳細記述が載っているわけではありません。
別の例として会計分析です。帳簿のデータベースには支払先のインボイスの情報が入っています。でもそれだけでなく、会計士が実際の経費の見積もりを立てて手動で帳簿に加えます。そうしないと経費を少なめで財務諸表ができてしまうからです。その場合、会計士たちはしっちゃかめっちゃかの支払先の名前を入力します。 例えば支払先の会社名の後に勝手にインボイス番号をくっつけたり、文章を入れたり・・・。そのバリエーションは無限大です。 わたしの仕事は支払先別に支払額をピボットテーブルでまとめることです。ピボットテーブルは支払先の名前が ・ 一つ違っても別のグループに集計されてしまいます。 ですからわざわざ適当な支払先の名前を統一した名前に打ち直します。 その行数１万行以上あります。
PowerQueryで支払い先の正式名と会計士が入れた法則のない支払先名をPowerQueryでバシッと取得変換したいところですが、その２つのデータベースにプライマリーキーはありません。 あったらどんなに良いかと思いますが、プライマリーキーがなければ法則のない支払先名をPowerQueryで一気に変換はできません。
実際はVBAでやっています。 例えば銀行なら詳細の最初の文言がある言葉から始まるならそれはある会計項目に振り分ける・・・などを組み込んでます。 支払先ならVBAのコードに支払先の最初にこれこれの文字で始まるなら正式名はこれ・・・みたいなコードを作っています。 支払先は千件以上あるし、支払先のバリエーションは無限ですのでそのコードを新しい支払先のバリエーションが加わるたびにコードを追加しています。 だからコードの長いことと言ったら・・・。
実際他の会計士は個人的にどうやって会計分析をしているだろうと不思議に思います。 適当な支払先を入力したら自分たちもピボットテーブルで分析できないだろうと思うのですが、多分全員フィルターなどを使っているのだと思います。
仕事で使うデータベースの大半はプライマリーキーがないです。でも結合して仕事をしなくてはなりません。そのほとんどが目による観察です。 将来プログラムがプライマリーキーのない複数のデータベースにプライマリーキーをAIで想定して自動で振ってくれるようにならないかな…と思っています。
LiLi803
2022年8月3日水曜日 4:55 | 1 票
> Microsoft Scripting Runtimeの参照設定にチェックボックスを入れると、Excel VBAがCollectionのみならずDictionaryも使える
「Collectionのみならず」というのはよく分かりませんが Dictionary オブジェクトを使えるようになります。
> Dictionaryを使うコードがあるエクセルファイルは個別にその都度ツールを開き、Microsoft Scripting Runtimeのボックスにチェックを入れる必要がありますか
Excel ブックを保存すれば参照設定も保存されるので、都度チェックは必要ありません。
ただ Dictionary を使うのに参照設定は必須ではありません。最初に提示したコードでは参照設定せずに動くように「遅延（レイト）バインディング」しています。参照設定するのは「事前（アーリー）バインディング」といい、個人的には基本後者を使います。その方がインテリセンス（入力補完）が使えてコーディングがしやすいからです。
最後の accountNo については何か誤解をされているようですが、これは単なる String 型変数です。
2022年8月3日水曜日 23:50
Shasano様：
ご回答ありがとうございます。
動的配列について調べているとき、ある動画で『ExcelはDictonaryは使えない。でもCollectionは使える。でもMicrosoft Scripting RuntimeをチェックすればExcelでもDictionaryが使える』と言っていたのですが、ひょっとしたらとても古い動画だったのかもしれません。すみません。
ブックを保存すれば参照設定も保存されるとのことでよかったです。
accoutNoは一般的な変数なんですね。 わかりました。ありがとうございます。
仕事では一連の関連がある複数の変数を使うことが非常に多いので、配列は避けて通りません。必要な時に必要な場所で使うように努力します！！ そうしないと延々と別々の名前の変数を作ることになって自分でもどの変数がなんだったんだかわからなくなってしまいます。
LiLi803
2022年8月19日金曜日 2:41
お力を下さった皆様：
戻ってまいりましたが、今月は予期せぬことが起こりました。
いつも月の初めでこの仕事をしているのですが、今月に限ってレポートの出力に問題があり、なんと『分析・Analyze』のレポートが出力できませんでした。 結局、月初の仕事の終わりごろやっと『最終・Final』版のレポートは出力できたのですが、分析なしでいきなりコメントを入力する羽目になりました。 よって大変珍しいことなのですが『転記』なしの月になりました。
来月また戻ってまいります。 来月はこんなことにならないと思いいます。
動作はもう限りなく本物に近いサンプルで確認しましたが、来月今一度試したいと思います。それまでに勉強を続けるのでコメントなどを入れてみたいと思います。
投票も必ず致します。
ありがとうございます。 それでは来月！
LiLi803
2022年9月13日火曜日 1:23
KokemomoYamamomo様
おはようございます。 やっと9月になって帰ってきました。
８月の月初の仕事が終わりました。 KokemomoYamamomo様に頂いたDo Whileのコードで無事に転記できました。
本当にありがとうございます。 今まで行数が合うところをだけを目で追って、何回もコピペしていたので、非常に助かります！！
わたしが最終コメントを追加したコードを貼らせていただきます。 きっとわたしのような仕事をしていらっしゃる方がいると思いますのでこのスレッドの資産の一つとして・・・。
本当にありがとうございます。
Sub TENKI_DO_WHILE_V6()
'Transfer comment from "Analyze" sheet to "Final" sheet in a comment column which matches both Account Number and Department Number.
Dim sheetA As Worksheet 'sheetA = Analyze Sheet = Copy from
Dim sheetB As Worksheet 'sheetB = Final Sheet = Copy to/Transfer to
Dim LR As Long 'Last column number of SheetA or SheetB??? Get at Column 2
Dim LC As Long 'Last column number of SheetA and SheetB
Dim blnkRowCount As Integer 'BlankRowCount = To count blank row.
Dim i As Long
Dim colBData As String ' "Analyze" sheet Column B string = Department Number
Dim colCData As String ' "Analyze" sheet Column C string = Account Number
'Dim colCData As String ' "Analyze" sheet Column C string = Comment
Dim colCmntData As String ' "Analyze" sheet Column C string = Comment
Dim strItemTitle As String ' to get Account number in "Analyze" sheet such as 635000
Dim topRowNum As Long '"Anaylze" sheet top Row number
Dim endRowNum As Long '"Analyze" sheet end Row Number
Dim tgtTitleRow As Long ' "Final" Sheet Account Number
Dim tgtTopRowNum As Long ' "Final" Sheet Top row
Dim tgtEndRowNum As Long ' "Final" Sheet end row
'Dim hitFlag As Boolean 'Variable to eveluate if applicable Department number exists or nor will not be used as not necessary数
Dim myRetVal As Variant
Dim j As Long
Dim k As Long
Dim strData As String
Dim buNum As Long ' Department Number
Set sheetA = ThisWorkbook.Worksheets("Analyze")
Set sheetB = ThisWorkbook.Worksheets("Final")
With sheetA ' "Analyze" sheet = Copy from/Transfer from
LC = .Cells(9, .Columns.Count).End(xlToLeft).Column
blnkRowCount = 1
i = 11 '<< First Account Number Group starts always from Row 11 in both Analyze sheet and Final sheet.
Do While blnkRowCount <= 10
colBData = .Cells(i, 2).Value 'For Department number column 2
colCData = .Cells(i, 3).Value 'For Account Number column 3
colCmntData = .Cells(i, LC - 5).Value 'For Comment string. LC -5 column
If blnkRowCount > 0 And colCData <> "" And colBData = "" Then
'If there is a value in Column C immedicate after blank row but empty in Column B, it is possible that the cell contains an Account Number title
blnkRowCount = 0
If IsNumeric(Left(colCData, 6)) = True Then '-If IsNumeric(Left(colCData, 6)) Then can be also used.
'If colCData starts with 6 numbers: colCData is Account number of account group, run following
' strItemTitle = Left(colCData, 6) 'Get first 6 string from Left in Account Number Title on "Analyze" Sheet = Account number
strItemTitle = colCData 'Since total row has a number, finding partial string does not work.
topRowNum = i ; 1 'Get first row number of records on "Analyze" Sheet = Header row number ; 1
endRowNum = .Cells(i, 3).End(xlDown).Row ' Get last row number of record on "Analyze" under an account number group
'To confirm it's a total row.
With sheetB '"Final Sheet" = Transfer to
LR = .Cells(Rows.Count, 2).End(xlUp).Row
tgtTitleRow = .Range(.Cells(11, 3), .Cells(LR - 1, 3)).Find(What:=strItemTitle, LookAt:=xlWhole).Row 'Get row number of account number on "Final" Sheet
'Change from Partial to Whole match.
tgtTopRowNum = tgtTitleRow ; 1 'Get first row number of records on "Final" Sheet = Header row number ; 1
tgtEndRowNum = .Cells(tgtTitleRow, 3).End(xlDown).Row ' Get last row number of record on "Final" under an account number group
'To confirm it's a total row.
For j = topRowNum To endRowNum - 1 'Since endRowNum is a total row, -1
strData = sheetA.Cells(j, LC - 5).Value 'Get comment value from Analyze sheet
If strData <> "" Then
buNum = sheetA.Cells(j, 2).Value 'Get Department number from "Analyze" Sheet
For k = tgtTopRowNum To tgtEndRowNum - 1 'If Account number and Department number mathches transfer value from "Analyze" Sheet to "Final Sheet"
'tgtEndRowNum is total row, repeat to -1 row.
If .Cells(k, 2).Value = buNum Then
'If .Cells(k, LC - 5).Value = "" Then - Comment out for now as not needed
.Cells(k, LC - 5).Value = strData
End If
Next k
End If
Next j
End With
i = endRowNum
Else
'If colCData does not start with 6 numbers, it is not an Accont Number. Do nothing.
End If
ElseIf colCData = "" And colBData = "" Then 'If both Department number and Account number is empty cells
blnkRowCount = blnkRowCount ; 1
ElseIf colCData = "" And colBData <> "" Then 'If Account number is empty but Department number has a value
blnkRowCount = 0 'Not required but entered for accuracy.
Else
'Do nothing as this does not apply
blnkRowCount = 0 'Not required but entered for accuracy.
End If
i = i ; 1
Loop
End With
Set sheetA = Nothing
Set sheetB = Nothing
MsgBox "fini"
End Sub
LiLi803
2022年9月13日火曜日 1:31
Shasano様
おはようございます。 やっと9月になって帰ってきました。
８月の月初の仕事が終わりました。 Shasano様に頂いた連想配列のコードで無事に転記できました。
本当にありがとうございます。 今まで行数が合うところをだけを目で追って、何回もコピペしていたので、非常に助かります！！
わたしができるところだけコメントを入れたコードを貼らせていただきます。
すみません・・・わたしの知識不足で全部正しいコメントを入れられませんが、これはわたしのこれからの課題とします。今、一生懸命配列の勉強をしています。配列は理解ができても、どこで使っていいのかわからないユーザーが多くいると聞きます。 わたしはまだ理解さえもしていない段階ですが、これからも勉強し続けます。 わたしが質問を上げさせていただいた仕事で連想配列が使えるというのも、『用途』を知るきっかけになりました。本当にありがとうございます。
Sub TENKI_DICTIONARY_V2()
Dim sheetA As Worksheet: Set sheetA = Worksheets("Analyze")
Dim sheetF As Worksheet: Set sheetF = Worksheets("Final")
'Column number where Comments are entered
Dim colComment As Long: colComment = Cells(9, Columns.Count).End(xlToLeft).Column - 5
'Declare Dictionary
Dim comDic As Dictionary
'Set Dictionary
Set comDic = New Dictionary
'Working with Analyze Sheet
With sheetA
Dim i As Long
'From 11(Row number where data starts) to Last row
For i = 11 To .Cells(Rows.Count, 2).End(xlUp).Row
'If Row i, Column B is Blank and Column C Left 6 strings are numeric, then
'Enter the 6 numeric number ( = Account Number into ) variable accountNo
If .Cells(i, 2) = "" And IsNumeric(Left(.Cells(i, 3), 6)) Then
Dim accountNo As String
accountNo = Left(.Cells(i, 3), 6)
End If
'If Row i, Column B is not blank, AND Row i, Column C is not blank, AND Row i, Column with Commentis not Blank, then
'Enter Comment into comDic...????
If .Cells(i, 2) <> "" And .Cells(i, 3) <> "" And .Cells(i, colComment) <> "" Then
comDic(accountNo & .Cells(i, 2).Value) = .Cells(i, colComment)
End If
Next
End With
'Working with Final Sheet
With sheetF
'From i 11 where data starts to last row
For i = 11 To .Cells(Rows.Count, 2).End(xlUp).Row
'If Row i, column B is blank and Row i Column C Left 6 strings are numeric,
'Then enter left 6 string into variable accountNo.
If .Cells(i, 2) = "" And IsNumeric(Left(.Cells(i, 3), 6)) Then
accountNo = Left(.Cells(i, 3), 6)
End If
'If ??? Then
'????
If comDic.Exists(accountNo & .Cells(i, 2).Value) Then
.Cells(i, colComment) = comDic(accountNo & .Cells(i, 2).Value)
End If
Next
End With
LiLi803
2022年9月20日火曜日 0:31
motosan様：
ありがとうございます！
使わせていただき、必ずお返事をさせていただきます。。
このスレッドでさせていただいた質問は、わたしが３年以上あきらめていたマクロで、今回いろいろ学び、またあきらめずにVBAを勉強しようと思いなおしたのでした。
最近はずっと連想配列の動画を見続けているのですが、やっと少しわかったことは普通の『配列』と『連想配列』は違う・・・と言うことです。わたしはそんなこともよく理解していませんでした。
普通の配列はインデックス番号でひとつひとつ独立した要素を取り出せますが、連想配列はキーとアイテムを紐づけてペアにして保持できるということ。 そう考えると連想配列はなんで『配列』というのかな？と思うぐらい配列じゃない気がしますが、連想配列はObjectだとどこかで読んだ気がします。 英語ではDictionaryと呼んで一般の配列と区別しているのかもしれません。
一般的な使い方としては、まず連想配列にキーとインデックスを;納する。 必要な場所で必要な情報を連想配列から読み込む・・・という流れになっていると思います。そしてそれには結構定型のコード作法があると思いました。
とても、とても勉強になります。
ありがとうございます！
LiLi803
2022年9月20日火曜日 1:00
motosan様：
コードを使わせていただきました。
Analyzeシートの会計番号・部番号・コメントの文字列が、きっかりとFinalシートの同じ会計番号・部番号の行に貼り付けられました。本当にありがとうございます。
コードを見て、まずは理解できるように努めます。
多分・・・少しづつは使えるようになります。 仕事でどうしても業務を効率化する必要に迫られています。
ある意味迫られていることがよいことなのかもしれません。そうでなければ既存の手作業をずっと続けていたかもしれません。しかし、Excel VBAは人類に与えられたギフト（大げさかもしれませんが・・・）なのだから使わなくてはもったいない！と思っています。
引き続き、勉強し続けます。
ありがとうございます！
LiLi803
2022年9月20日火曜日 7:09
LiLi803 さま
motosanです。
Dictionary(連想配列のコード)としたのは良くなかったかもしれません。
Dictionaryはディクショナリであって「連想配列のようなもの」です。
プログラミングの解説ではディクショナリという用語が良く使用されています。
>> 連想配列はなんで『配列』というのかな？
配列は「要素の位置」を指定して要素にアクセスします。
連想配列は「要素を連想できるキー」を指定して要素にアクセスします。
「要素を連想できるキー」は常に存在しているような動作になります。
（実際には、最初にアクセスした時に領域が確保されるのでしょうが）
アクセスするための記法が同じなので配列とよぶのだと思います。
それに対して、Dictionaryは（キー、値）のペアーで要素を追加する必要があります。
追加された要素に対するアクセスは配列と同じようにできます。
以上、連想配列についての簡単な説明でした。
2022年9月21日水曜日 1:15
motosan様：
ご教授ありがとうございます。
なるほど、アクセスするための記法が同じなのですね。たしかに一般の配列と;ているようなコードを使うと思いました。
もし・・・もしよろしかったら以下を教えていただけますか？
rowAは数字/行数だと思います。
なぜ連想配列名(Strkey、会計番号と部番号のコンボ、これはキー。アイテムではない）にすると行数という数字が返ってくるのでしょうか？（間違っていたらすみません）
rowA = sheetADic(strKey)
LiLi803
2022年9月21日水曜日 4:52 | 1 票
LiLi803 さま
rowAは数字/行数です。
Dictionary へは CreateDic Function 内で次のようにしてキーとアイテムを登録しています。
Call CreateDic.Add(strKey, i)
知らなかったのですが、VBA の Dictionary では下記の記述でも登録できるようです。（連想配列と同じ）
但し。 CreateDic は Function名と同じなのでエラーになります、
CreateDic(strKey) = i
この方法を採用する場合は以下のようにdic変数を定義してそこに;納し、最後にCreateDicに代入する必要があります。
Dim dic As Dictionary
Set dic = New Dictionary
If dic.Exists(strKey) Then
Call MsgBox("キー重複：" & strKey)
Else
dic(strKey) = i
End If
Set CreateDic = dic
End Function
ちなみにDictionary の説明は下記にあります。
以上。
追記）
Dictionary の Exists メソッドを使用しない場合は下記のように記述できます。
If Not IsEmpty(dic(strKey)) Then
※ 但しこの場合は、strKey のキーをもった要素がなかった場合、キーがstrKeyで値がEmptyの項目が追加されます。（連想配列の動作と同じ）
この後 dic.Exists(strKey)は常にTrueになります。（今回の処理ではdic(strKey) = iで置き換わるので正しく動作します。）
私としては、連想配列としての記述よりも、Dictionaryオブジェクトの Add, Remove, Exists 等のメソッドを使用した方が分かりやすいと思います。
追記 終わり
2022年9月22日木曜日 1:04
motosan様：
説明をして下さり誠にありがとうございました。
なるほど、iがアイテムとして使われているから、紐づけられたキーから行番号を召喚できるのですね。
（召喚って言わないのかもしれませんが・・・すみません）
VBAリファレンスのサイトを参照してくださってありがとうございます。 読んでみてスラスラ理解はできないのですが、実務でやっていることに関連すればもう少し具体的に理解することが可能かもしれません。
申し訳ないのですが、やはり連想配列とDictionaryの定義の違いがはっきりわかりません。
インターネットで調べても『Dictionaryオブジェクト（連想配列）の使い方』…みたいな紹介をされていてDictionaryと連想配列が同義語になっています。
多分私がExcel VBA以外のコンピューター言語を全く知らないので違いが分からないのかもしれません。他の言語ではDictionaryと連想配列の定義が分かれているのかもしれません。
今のところ辞書(Dictionary)はオブジェクト。 連想配列を使うための箱・Systemみたいなもの。
配列の中には一般配列(array)と連想配列(Associative array)があり、連想配列(Associative array)は配列と言う大きなグループの一部…と理解しています。
ありがとうございました。
LiLi803
2022年9月25日日曜日 23:59 | 1 票
LiLi803 さま
motosanです。
しつこいようですが、連想配列とDictionaryについての補足をします。
Exel VBA の Dictionary は確かに連想配列です。
常に 変数としてdic(key) の記述ができることが連想配列の機能です。
key が Dictionaryにあるかどうかに関係なく使用できます。（ない場合は(key, Empty)のペアで追加される）
他の言語の一般的な Dictionaryであれば key がDictionaryにない場合、dic(key) の記述は実行時エラーになります。
Dictionaryに登録するのか、すでにある値を置き換えるかを意識する場合は DictionaryのAddメソッド、Existsメソッドを使用すべきだと思います。
Addメソッドでは同じキーを登録したらエラーになるのでケアレスミスが少なくなると思います。
連想配列で注意すべきなのは、下記のような記述で Dictionaryに(key, Empty)のペアが登録されてしまうことです。
Set dic = New Dictionary
strValue = dic(key)
dic の Countプロパティは 1 になります
Dictionaryに不要なアイテムを登録しないためには、下記のように Exists メソッドを使用します。
If dic.Exists(key) Then
strValue = dic(key)
End If
代入する場合、キーが存在するかチェックする必要がない場合は、連想配列としての記述が簡単です。
dic(key) = value
下記のコードで確認できると思います。
Dim dic As Dictionary
Dim strKey As Variant
Dim strValue As Variant
Set dic = New Dictionary
dic("きりん") = "動物"
dic("きりん") = "鳥" 'キーのコーディングミス(dic("すずめ") = "鳥" のミス)
'Call dic.Add("きりん", "鳥") の場合はエラーとなる
'VBAでは dic.Add "きりん", "鳥" とも記述できる
If dic.Exists("ぞう") Then
strValue = dic("ぞう")
End If
strValue = dic("ライオン")
MsgBox dic.Count
For Each strKey In dic.Keys
MsgBox strKey & " : " & dic(strKey)
If IsEmpty(dic(strKey)) Then
MsgBox strKey & " の値は Empty です"
End If
Next
例では dic.Count が2になり、dic.Keysは2件になります。
i以上。
2022年9月26日月曜日 20:01
motosan様：
お返事ありがとうございました。
いえいえ、わたしがず～っと連想配列について質問し続けてます。。。恐れ入ります。そしてありがとうございます。
Dictionaryに;納する方法を２通りご教授してくださりありがとうございます。
＞他の言語の一般的な Dictionaryであれば key がDictionaryにない場合、dic(key) の記述は実行時エラーになります
わかりました。覚えておきます。
Addメソッド、Existsメソッドは積極的に使用するようにします。この出発点で間違えると、その後のコードの実行で希望通りの結果が出ませんね・・・。 (key, Empty)のペアはわたしとしてはちょっと怖い感じがします。気を付けます。
サンプルのコードで具体的にご教授してくださりありがとうございました。Lionは確かにEmptyになりますね。なるほど・・・。
本当にありがとうございます。
LiLi803