エクセルVBAについて

Question

画像の左ファイル(CSV)のN列の材質とO列の寸法を右ファイル(エクセル)
M列(材質)とN列(寸法)に転記させたいです。
注文番号がマッチすれば転記するといった感じです。
注文単価も転記できるようにしています。
単価を転記するマクロは以下になります。
このマクロにコ－ドを追加して単価と一緒に材質と寸法を転記できるようにしたいです。
CSVファイルは11行目からスタートで、多い時は1000点程あります。
条件は、右のエクセルファイルを開いている状態で、マクロを起動する。
シ－ト名は"外注別手配分"です。
左のCSVファイルを選択して転記完了。
よろしくお願いします。

Public Sub 転記()
Dim myFile As Variant
Dim ans As Integer
Dim dicT As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim ms As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As String
Set ms = Worksheets("外注別手配分")
myFile = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
If myFile = False Then Exit Sub
Set wb = Workbooks.Open(myFile)
Set ws = wb.Worksheets(1)
Set dicT = CreateObject("Scripting.Dictionary")
maxrow1 = ws.Cells(Rows.Count, "H").End(xlUp).Row
maxrow2 = ms.Cells(Rows.Count, "J").End(xlUp).Row
For row1 = 2 To maxrow1
key = ws.Cells(row1, "H").Value
dicT(key) = ws.Cells(row1, "P").Value
Next
For row2 = 2 To maxrow2
If ms.Cells(row2, "H").Value = "" Then
key = ms.Cells(row2, "J").Value
If key <> "" Then
If dicT.exists(key) = True Then
ms.Cells(row2, "H").Value = dicT(key)
Else
ms.Cells(row2, "H").Value = ""
End If
End If
End If
Next
Range("A2:A2000").EntireRow.Delete
wb.Save
wb.Close

End Sub

Qchan1962 · Accepted Answer

こんにちは
＞マッチしていないところはセルに元々記載があった場合、消えてしまいます。
これは、ご質問コードにある処理です。（あるので消したいのだと解釈）
ms.Cells(row2, "H").Value = dicT(key)マッチしたら（CSVにあれば）
なので　その Else 側（この場合Elseそのものも要らない）
ms.Cells(row2, "H").Value = ""　を消してみてください

＞毎日CSVデータからエクセルに落としこんでいますので、前の日のデータは消すようにしています。このやり方がベストなのかは分かりませんが…

Application.GetOpenFilenameでファイルを指定しているので
削除する必要はなさそうに思います。。。コードでは中身だけを削除しているのでファイルは残りますしね。

もし、ファイル自体を削除するなら・・・色々方法はありますが・・
Elseの件でVBAは分からないと言う事でしょうから
デバッグ中は特に確認などの意味を含め　やめた方だ良さそうですね

＃７の方法、csvファイル削除、処理速度UPなど課題が残りますね
ここまで来たら、書き直すのはやぶさかではありませんが・・・
改修手直しや確認作業を考えると　該当箇所を手直しして　
とりあえず使用する（試す）のは、どうでしょう

Qchan1962 · Answer

おはようございます　
連投すみません。ご質問と関係ないのですが、
私的には出来るだけ、ご質問の提示コードで・・回答をと考えるようにしていますが、やはり、加工の必要が無いデータをDictionaryを使ったりしているのにExcelブックでcsvを開くところやデータを削除して空にするところが・・・
データを削除しているからスルーしようかなと思っておりましたが、
どうしても、しっくりしません。

csvデータの取得方法は色々ありますが、Dictionaryを使うなら、尚更ブックは無いです。（ご質問の場合、csvデータを一時出力する必要性がありません）

申し訳ないとは思いますが、csvデータ取得部分も参考の為、書いて置きます

Dim key As String
Dim buf As Variant
myFile = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
If myFile = False Then Exit Sub
Set dicT = CreateObject("Scripting.Dictionary")
Open myFile For Input As #1
Do Until EOF(1)
    Line Input #1, key
    buf = Split(key, ",")
    If UBound(buf) > 14 Then
        key = buf(7)
        If key <> "" Then
            If Not dicT.exists(key) Then
                dicT.Add key, buf(13) & "|" & buf(14) & "|" & buf(15)
            End If
        End If
    End If
Loop
Close #1
Erase buf

'buf(13)は0から13番目なのでN列に相当する区切りデータ

Qchan1962 · Answer

＃５の続き
ご質問のコードを少し追加（書き方を変えず）して下記の様にしてみました
＃２と内容は同じだと思いますが・・・
If ms.Cells(row2, "H").Value = "" Then　は　単価が入っていると出力されないので＃４で書いている通り、削除（コメントアウト）しました
（これが原因だったりして・・）

Public Sub 転記()
Dim myFile As Variant
Dim ans As Integer
Dim dicT As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim ms As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As String
Set ms = Worksheets("外注別手配分")
myFile = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
If myFile = False Then Exit Sub
Set wb = Workbooks.Open(myFile)
Set ws = wb.Worksheets(1)
Set dicT = CreateObject("Scripting.Dictionary")
maxrow1 = ws.Cells(Rows.Count, "H").End(xlUp).Row
maxrow2 = ms.Cells(Rows.Count, "J").End(xlUp).Row
For row1 = 2 To maxrow1
key = ws.Cells(row1, "H").Value
'①P列の値と一緒に他の値も文字列を作り入れている
'key重複でエラーの可能性あり
dicT(key) = ws.Cells(row1, "N").Value & "|" & ws.Cells(row1, "O").Value & "|" & ws.Cells(row1, "P").Value
Next
Dim buf As Variant
For row2 = 2 To maxrow2
'If ms.Cells(row2, "H").Value = "" Then
key = ms.Cells(row2, "J").Value
If key <> "" Then
If dicT.exists(key) = True Then
ms.Cells(row2, "H").Value = dicT(key)
'②上記で作った文字列を区切り文字で分けて各列に代入している
                     buf = Split(dicT.Item(key), "|")
                    ms.Cells(row2, "M").Value = buf(0)
                    ms.Cells(row2, "N").Value = buf(1)
                    ms.Cells(row2, "H").Value = buf(2)
Else
ms.Cells(row2, "H").Value = ""
End If
End If
'End If
Next
'確認の為　削除も閉じもせずそのままで
'Range("A2:A2000").EntireRow.Delete
'wb.Save
'wb.Close
End Sub

単価が出力できるのなら、①②でも出力できるハズですがどうでしょう

Qchan1962 · Answer

>回答頂いたコ－ドを試してみましたが、転記はできませんでした。
デモデータを作り試しましたが何故か出力されました
＃３で訂正したところは、下記の様に取り除きました

With ms  'CSVにある番号の場合Dictionaryからデータを抽出出力
    For row2 = 2 To .Cells(.Rows.Count, "J").End(xlUp).Row
            key = .Cells(row2, "J").Value
            If key <> "" Then
                If dicT.exists(key) Then '登録があれば
                     buf = Split(dicT.Item(key), "|")
                    .Cells(row2, "M").Value = buf(0)
                    .Cells(row2, "N").Value = buf(1)
                    .Cells(row2, "H").Value = buf(2)
                Else
' .Cells(row2, "H").Value = ""  '？？
                End If
            End If
    Next
End With

＞単価
は出来ると言う事でこれも試しました。
たしかにOKですね（当然）

＞dicT(key) = ws.Cells(row1, "P").Value
と同じことを下記の様に
dicT.Add key, .Cells(row1, "N").Value & "|" & .Cells(row1, "O").Value & "|" & .Cells(row1, "P").Value
｜の区切り文字で入れて繋げた値で代入して
Splitで分け、各セルに代入しているので同じような事を行っているはずなのですが・・

ちなみに・・ＣＳＶファイルは空の行を出力しないと思うのですが
加工していますか？
どのようなデータなのかな？テキストベースで内容が欲しいところです

あと、保存前に何故行を削除するのでしょう？
教えてもらえますか・・
と言っても他のQAでも悩まれているようなので・・・続く

KenKen_SP · Answer

こんにちは。

目的が注文番号による名寄せみたいなことならば、シンプルに vlookup 関数入力、フィルコピーの手順をVBAで書くとか。

もちろん、ご提示のソースの様な方法で良いですし、その解決策の回答は既にでています。

それじゃなければ不可という状況でないなら、ご自身で理解し易い方法をおすすめします。

他には CSV に直接 SQL でデータを問い合わせ、結果を CopyFromRecordset で貼り付けるやり方もあります。

Qchan1962 · Answer

デモデータを作って試しました
ここを変更するのを忘れていました
For row2 = 2 To .Cells(.Rows.Count, "J").End(xlUp).Row
If .Cells(row2, "H").Value = "" Then　'ここ
key = .Cells(row2, "J").Value

J列で番号があったらなので
    For row2 = 2 To .Cells(.Rows.Count, "J").End(xlUp).Row
        If .Cells(row2, "J").Value <> "" Then
            key = .Cells(row2, "J").Value

ですね

If .Cells(row2, "H").Value = "" Thenなので見当違いぽいですね；

Qchan1962 · Answer

こんばんはイマイチなさりたい事が分かりません・・が CSVデータ内のデータで既に登録がある注文番号の場合、材質などを CSVから抽出したいのかな？少し書き直してみました削除や空白、保存は取り敢えずコメントアウトして単価　P＝＞H列も書き出します比較基準は注文番号CSVH列と既存シートJ列選択セルの入力規則が気になりますが・・・画面抑制などは書いていません見当違いなら捨ててください Public Sub 転記() Dim myFile As Variant Dim ans As Integer Dim dicT As Object Dim wb As Workbook Dim ws As Worksheet Dim ms As Worksheet Dim row1 As Long Dim row2 As Long Dim key As String Dim buf As Variant Set ms = Worksheets("外注別手配分") myFile = Application.GetOpenFilename("CSVファイル(*.csv),*.csv") If myFile = False Then Exit Sub Set wb = Workbooks.Open(myFile) Set ws = wb.Worksheets(1) Set dicT = CreateObject("Scripting.Dictionary") With wb.Worksheets(1) 'CSVデータをDictionaryに For row1 = 2 To .Cells(.Rows.Count, "H").End(xlUp).Row key = .Cells(row1, "H").Value If key <> "" Then If Not dicT.Exists(key) Then dicT.Add key, .Cells(row1, "N").Value & "|" & .Cells(row1, "O").Value & "|" & .Cells(row1, "P").Value End If End If Next End With With ms 'CSVにある番号の場合Dictionaryからデータを抽出出力 For row2 = 2 To .Cells(.Rows.Count, "J").End(xlUp).Row If .Cells(row2, "H").Value = "" Then key = .Cells(row2, "J").Value If key <> "" Then If dicT.Exists(key) Then '登録があれば buf = Split(dicT.Item(key), "|") .Cells(row2, "M").Value = buf(0) .Cells(row2, "N").Value = buf(1) .Cells(row2, "H").Value = buf(2) Else ' .Cells(row2, "H").Value = ""　’？？ End If End If End If Next End With 'Range("A2:A2000").EntireRow.Delete 'wb.Save 'wb.Close End Sub

fujillin · Answer

こんばんは

全体でなさりたいことがよくわかりませんけれど・・
（ざっと見ただけなので、読み間違えがあるかも知れません。ご容赦。）
素直に考えると、Dictionaryに入れるデータが、逆ではないかという気がします。
（右のシートが、台帳的なもののように思えるので・・）

＞CSVファイルは11行目からスタートで、～
＞For row1 = 2 To maxrow1
コードでは2行目から処理しているように見えますけれど・・？

記入する際も、
＞If ms.Cells(row2, "H").Value = "" Then
なので、単価が記入されていたら、その項目は処理しないようになっていますけれど？

また、
＞For row2 = 2 To maxrow2
で、台帳側に記載のある注文番号だけを処理していますが、もしもCSVファイルに新しい（？）注文番号が含まれている場合は、無視されることになりそうな気がしますけれど・・
（そのようなことは、起こり得ないようになっているのかも知れませんが）

ひとまず、現状のままで行いたければ、
＞dicT(key) = ws.Cells(row1, "P").Value
で、Dictionaryに登録する際に、P列とN列を併せて登録しておいて、記入する際に二つのセルに記入するようになされば、ご質問内容は実現できると思います。
ただし、Dictionaryに直接二種類の値を登録はできませんので、配列化して登録するか、あるいは「使用されないであろう文字」を区切りとして、文字列連結をしてまとめて登録するなどになるものと思います。
記入する際には、配列ならそれぞれの値を記入、文字列なら、区切り文字で分割してから記入、といった要領になるでしょう。

先にも述べましたが、Dictionaryを作成するにしても、右側のシートのJ列をDictionary化して、値を行番号等にしておく方がわかりやすいのではないかと想像します。
（検索速度さえ気にしなければ、Dictionary化する必要もありませんけれど）
もっとも、この方法をとる場合でも「CSV内に同じ注文番号が存在していた場合」どうするのかを考えておいた方がよさそうに思います。
（そのようなことは、起こり得ないようになっているのかも知れませんが）

エクセルVBAについて

こんにちは

おはようございます

＃５の続き

>回答頂いたコ－ドを試してみましたが、転記はできませんでした。

こんにちは。

デモデータを作って試しました

こんばんは

こんばんは

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おはようございます　