プロが教える店舗&オフィスのセキュリティ対策術

画像の左ファイル(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

「エクセルVBAについて」の質問画像

A 回答 (8件)

こんにちは


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

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

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

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

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

ありがとうございます。
解決しました。
感謝します。

お礼日時:2022/07/16 19:45

おはようございます 


連投すみません。ご質問と関係ないのですが、
私的には出来るだけ、ご質問の提示コードで・・回答をと考えるようにしていますが、やはり、加工の必要が無いデータを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列に相当する区切りデータ
    • good
    • 0
この回答へのお礼

こんばんは。
今日の午前2時くらいに送って頂いたコードでできました。
ありがとうございます。
もうひとつお願いがあります。
頂いたコードだと注文番号がマッチした場合は、単価、材質、寸法と入力されるのですが
マッチしていないところはセルに元々記載があった場合、消えてしまいます。
元々、記載がある場合はそのままにしておきたいです。
質問の内容ですが、元々EDIというシステムからエクセルにデータを落としこんでいます。
EDI からCSVに変換できる機能があるので、それを利用しています。
毎日CSVデータからエクセルに落としこんでいますので、前の日のデータは消すようにしています。
このやり方がベストなのかは分かりませんが…
よろしくお願いいたします。

お礼日時:2022/07/15 21:20

#5の続き


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

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

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

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


デモデータを作り試しましたが何故か出力されました
#3で訂正したところは、下記の様に取り除きました

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で分け、各セルに代入しているので同じような事を行っているはずなのですが・・

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

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

こんにちは。



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

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

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

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

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


ここを変更するのを忘れていました
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なので見当違いぽいですね;
    • good
    • 0
この回答へのお礼

こんばんは。
回答ありがとうございます。
説明不足で申し訳ないです。
何がしたいかというと、左側のCSVファイルのデータのN列の材質とO列の寸法を右ファイル(こちらはエクセルファイル)に転記させたいのです。
材質はM列で寸法はN列にです。
その転記方法ですが、注文番号をマッチさせて転記できないかということです。
注文番号が同じところにその材質と寸法が転記されるイメ-ジです。
例えば、左ファイルのH列11行目の注文番号は3385234なっていますが、
もし右ファイルのJ列2行目の注文番号が3385234であればマクロを起動させることで、単価\1650、材質SS400、寸法16X25Xが右ファイルに転記されるということです。
ちなみに、最初に投稿したコ-ドで注文単価だけは転記させることができます。
それに加えて、材質と寸法も一緒に転記させることができればということです。
この操作は毎日やる作業です。
現状は、毎日注文単価のみを転記させています。
回答頂いたコ-ドを試してみましたが、転記はできませんでした。
自分で何とかやってみようと思い、色々試してみましたが、うまくできないため投稿しました。
何とか助けていただけないでしょうか?
よろしくお願いいたします。

お礼日時:2022/07/14 23:58

こんばんは


イマイチなさりたい事が分かりません・・が

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
    • good
    • 1

こんばんは



全体でなさりたいことがよくわかりませんけれど・・
(ざっと見ただけなので、読み間違えがあるかも知れません。ご容赦。)
素直に考えると、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内に同じ注文番号が存在していた場合」どうするのかを考えておいた方がよさそうに思います。
(そのようなことは、起こり得ないようになっているのかも知れませんが)
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング