[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA(マクロ)動作について(行き詰まっております。)』（NAOKI）
マクロ(VBA)に行き詰まっております。
どうか、VBAに詳しい方、教えてください。
宜しくお願いいたします。
今回、作成にあたって、行き詰まっています内容を書き出してみました。
1,特AシートのC列と特A貼シートのE列の番号(C6-****)は一致。
2,特A貼シートのK〜M列の番号を元に特AシートD列〜の番号の所へ特A貼シート のG列の数量を反映させたい。
3,特Aシートの(D列〜)の番号は複数ある為、番号の位置は変わる可能性があります。
4,特A貼のG列の数量は特Aシートの番号(C5-*****)ごとに反映
※説明がうまくできず申し訳ありません。
説明足らずの所はご質問いただけましたら分かる範囲で説明させてください。
尚、ここまではチャットGPTで作成しております。(言語は分かりません。)
助けていただけたら幸いです。どうか、宜しくお願いいたします。
(特Aシート)
(A列) (C列) (D列〜) (4)4品名 単価ｺｰﾄﾞNo 48800 48838 48829 作業内容 組立 PINﾌﾘ ハズシタイバー 単価 21.01 3.11 8.22 取数 1 1 1 (8)FZ048AU440-2 C6-0030A-0004 (35) (35) (9)DZ345BC581-3 C9-5610A-0022 (10)FZ010AJG69-1 C5-2000A-1002 (172) (11)DZ149AWA18-2 C5-5310A-1002 (12)FZ048AU440-2 C6-0030A-0004 (13)FZ034BG748-2 C4-9880A-1003 (14)FZ022BH402-2 C5-0710A-1008
(特A貼シート)
(C列) (E列) (G列) (K〜M列)
(1)FZ048AU440-2 C6-0030A-0004 35 48800 48838
(2)DZ345BC581-3 C9-5610A-0022 491
(3)FZ010AJG69-1 C5-2000A-1002 381
(4)DZ149AWA18-2 C5-5310A-1002 172 48829
(5)FZ048AU440-2 C6-0030A-0004 746
(6)FZ034BG748-2 C4-9880A-1003 381
(7)FZ022BH402-2 C5-0710A-1008 312 48830
※(現時点での動作可能なVBAになります↓)※
Sub 実行ボタン()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Long
Dim sourceData As Range
Dim targetData As Range
Dim uniqueValues As Object
Set uniqueValues = CreateObject("Scripting.Dictionary")
' 特A貼シートを取得
Set sourceSheet = ThisWorkbook.Sheets("特A貼")
' 特Aシートを取得
Set targetSheet = ThisWorkbook.Sheets("特A")
' 特A貼シートのC列の最終行を取得
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "C").End(xlUp).Row
' C列のデータを特AシートのA8セルに反映
targetSheet.Range("A8:A" & (lastRow + 7)).Value = sourceSheet.Range("C1:C" & lastRow).Value
' 特A貼シートのK列の最終行を取得
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "K").End(xlUp).Row
' K列のデータを特AシートのD4セルから横に反映
Set sourceData = sourceSheet.Range("K1:K" & lastRow)
Set targetData = targetSheet.Range("D4").Resize(1, lastRow)
' データをセルに書き込み
targetData.Value = WorksheetFunction.Transpose(sourceData.Value)
' 特A貼シートのE列の最終行を取得
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "E").End(xlUp).Row
' E列のデータを特AシートのC8セルから下へ反映
Set sourceData = sourceSheet.Range("E1:E" & lastRow)
Set targetData = targetSheet.Range("C8").Resize(lastRow, 1)
' データをセルに書き込み
targetData.Value = sourceData.Value
' 特A貼シートのL列の最終行を取得
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "L").End(xlUp).Row
' L列のデータを特AシートのD4の行の最後尾から横へ反映
Set sourceData = sourceSheet.Range("L1:L" & lastRow)
Set targetData = targetSheet.Cells(4, targetSheet.Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, lastRow)
' データをセルに書き込み
targetData.Value = WorksheetFunction.Transpose(sourceData.Value)
' 特A貼シートのM列の最終行を取得
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "M").End(xlUp).Row
' M列のデータを特AシートのD4の行の最後尾から横へ反映
Set sourceData = sourceSheet.Range("M1:M" & lastRow)
Set targetData = targetSheet.Cells(4, targetSheet.Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, lastRow)
' データをセルに書き込み
targetData.Value = WorksheetFunction.Transpose(sourceData.Value)
' 特AシートのD4行に重複する値がある場合は重複を削除
targetSheet.Range("D4:IV4").RemoveDuplicates Columns:=Array(1), Header:=xlNo
' 特AシートのD4行に全く同じ数字がある場合は一つだけ表示
Dim cellValue As Variant
Dim checkRange As Range
Set checkRange = targetSheet.Range("D4:IV4")
For Each cellValue In checkRange
If Not IsEmpty(cellValue) Then
If Not uniqueValues.exists(cellValue.Value) Then
uniqueValues.Add cellValue.Value, 1
Else
cellValue.ClearContents
End If
End If
Next cellValue
' 特AシートのD4行に空白がある場合は空白を詰める
targetSheet.Range("D4:IV4").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
' 特AシートのD4行の数字を取得
Dim targetValues As Range
Set targetValues = targetSheet.Range("D4:IV4")
' 特AシートのD4行の数字に対応する単価一覧シートの行を検索し、D6行に反映
Dim targetValue As Range
Dim matchRange As Range
Dim priceSheet As Worksheet
Set priceSheet = ThisWorkbook.Sheets("単価一覧")
For Each targetValue In targetValues
If Not IsEmpty(targetValue) Then
Set matchRange = priceSheet.Range("A:A").Find(what:=targetValue.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not matchRange Is Nothing Then
' 作業内容を特Aシートに反映
targetValue.Offset(2, 0).Value = matchRange.Offset(0, 2).Value
' 作業内容を特Aシートに反映
targetValue.Offset(1, 0).Value = matchRange.Offset(0, 1).Value
End If
End If
Next targetValue
' 特Aシートを取得
Set targetSheet = ThisWorkbook.Sheets("特A")
' 特Aシートの最終列を取得
lastColumn = targetSheet.Cells(4, targetSheet.Columns.Count).End(xlToLeft).Column
' 特AシートのD4行の数字に対応するセルを検索し、D7行に反映
Dim col As Long
For col = 4 To lastColumn
If IsNumeric(targetSheet.Cells(4, col).Value) Then
targetSheet.Cells(7, col).Value = 1
End If
Next col
' 反映が完了したらメッセージを表示
MsgBox "実行が完了しました。", vbInformation
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows11 ＞
確認です。 1.作業内容を説明して下さい。 チャットGPTに作成を依頼したテキスト（文章）をこちらにもアップできませんか？ （まさか、その表だけで、自動でコードを作ったとは思えません。)
2. 表をもう少し見やすくできませんか?
行の最初を半角スペースで始めると、レイアウトが崩れにくいですよ。
そうすれば、皆さんからコメントが得られると思います。 （xyz） 2023/07/25(火) 20:41:13
1.作業内容を説明して下さい。(チャットGPTテキスト)
A,VBAを作成していく中で動作をGPTに依頼していた為、膨大なテキストになっております。(テキストは都度で羅列等しておりませんでした。
2,表をもう少し見やすくできませんか?
A,そういうやり方を知りませんでした。ありがとうございます。
再度スペースを利用して作成いたしました。
(少しは見やすくなったかもしれません)
※特Aシートにあります(35)や(172)をVBAで動作させたい最終形態になります。(35)等の()は無視してください。
(特Aシート) (A列) (C列) (D列) (E列) (F列〜) (4)品名 単価ｺｰﾄﾞNo 48800 48838 48839 作業内容 組立 PINﾌﾘ ハズシタイバー 単価 21.01 3.11 8.22 取数 1 1 1 (8)FZ048AU440-2 C6-0030A-0004 (35) (9)DZ345BC581-3 C9-5610A-0022 (172) (172) (10)FZ010AJG69-1 C5-2000A-1002 (11)DZ149AWA18-2 C5-5310A-1002 (172) (172) (12)FZ048AU440-2 C6-0030A-0004 (13)FZ034BG748-2 C4-9880A-1003 (14)FZ022BH402-2 C5-0710A-1008
(特A貼シート)
(C列) (E列) (G列) (K列) (L列〜)
(1)FZ048AU440-2 C6-0030A-0004 35 48800
(2)DZ345BC581-3 C9-5610A-0022 491 48838 48839
(3)FZ010AJG69-1 C5-2000A-1002 381
(4)DZ149AWA18-2 C5-5310A-1002 172 48838 48839
(5)FZ048AU440-2 C6-0030A-0004 746 48829 48830
(6)Z034BG748-2 C4-9880A-1003 381 48871 48881
(7)FZ022BH402-2 C5-0710A-1008 312 48828
（NAOKI） 2023/07/25(火) 22:03:17
申し訳ありません。
特Aシートの(491)を訂正いたしました。
(特Aシート)
(A列) (C列) (D列) (E列) (F列〜)
(4)品名 単価ｺｰﾄﾞNo 48800 48838 48839
作業内容 組立 PINﾌﾘ ハズシタイバー
単価 21.01 3.11 8.22
取数 1 1 1
(8)FZ048AU440-2 C6-0030A-0004 (35)
(9)DZ345BC581-3 C9-5610A-0022 (491) (491)
(10)FZ010AJG69-1 C5-2000A-1002
(11)DZ149AWA18-2 C5-5310A-1002 (172) (172)
(12)FZ048AU440-2 C6-0030A-0004
(13)FZ034BG748-2 C4-9880A-1003
(14)FZ022BH402-2 C5-0710A-1008
(特A貼シート)
(C列) (E列) (G列) (K列) (L列〜)
(1)FZ048AU440-2 C6-0030A-0004 35 48800
(2)DZ345BC581-3 C9-5610A-0022 491 48838 48839
(3)FZ010AJG69-1 C5-2000A-1002 381
(4)DZ149AWA18-2 C5-5310A-1002 172 48838 48839
(5)FZ048AU440-2 C6-0030A-0004 746 48829 48830
(6)Z034BG748-2 C4-9880A-1003 381 48871 48881
(7)FZ022BH402-2 C5-0710A-1008 312 48828
（NAOKI） 2023/07/25(火) 22:07:42
反映の条件
1, 特A貼のK列の縦列の値と特AシートD4行の横列の値が一致。
2, 特A貼のL列の縦列の値と特AシートD4行の横列の値が一致。
3, 特A貼のM列の縦列の値と特AシートD4行の横列の値が一致。
4, 特AシートC8列の縦列の値と特A貼シートE列の縦列の値が一致。
5, 1から4までの条件を満たすセルに特A貼シートG列の数字を反映。
(特Aシート)
(A列) (C列) (D列) (E列) (F列〜) (4)品名 単価ｺｰﾄﾞNo 48800 48838 48839 作業内容 組立 PINﾌﾘ ハズシタイバー 単価 21.01 3.11 8.22 取数 1 1 1 (8)FZ048AU440-2 C6-0030A-0004 (35) (9)DZ345BC581-3 C9-5610A-0022 (491) (491) (10)FZ010AJG69-1 C5-2000A-1002 (11)DZ149AWA18-2 C5-5310A-1002 (172) (172) (12)FZ048AU440-2 C6-0030A-0004 (13)FZ034BG748-2 C4-9880A-1003 (14)FZ022BH402-2 C5-0710A-1008
(特A貼シート)
(C列) (E列) (G列) (K列) (L列〜)
(1)FZ048AU440-2 C6-0030A-0004 35 48800
(2)DZ345BC581-3 C9-5610A-0022 491 48838 48839
(3)FZ010AJG69-1 C5-2000A-1002 381
(4)DZ149AWA18-2 C5-5310A-1002 172 48838 48839
(5)FZ048AU440-2 C6-0030A-0004 746 48829 48830
(6)Z034BG748-2 C4-9880A-1003 381 48871 48881
(7)FZ022BH402-2 C5-0710A-1008 312 48828
（NAOKI） 2023/07/26(水) 12:17:10
質問に限定した参考コードです。
Sub test()
Dim wsT As Worksheet
Dim wsS As Worksheet
Dim rng As Range
Dim lastCol As Long
Dim c As Variant
Dim k As Long, j As Long
Set wsT = Worksheets("Sheet1") '転記先(Target)
Set wsS = Worksheets("Sheet2") '転記元(Source)
Set rng = wsT.Range("D4:F4")
With wsS
For k = 1 To .Cells(Rows.Count, "C").End(xlUp).Row
If .Cells(k, "K").Value <> "" Then
lastCol = .Cells(k, Columns.Count).End(xlToLeft).Column
For j = 11 To lastCol
c = Application.Match(.Cells(k, j), rng, 0)
If IsNumeric(c) Then
' 対応する行は行がずれているだけで同一との前提。
' そうでなければ、Match関数なりを使った検索が必要。
wsT.Cells(k + 7, 3 + c) = .Cells(k, "G") 'カッコは省略（書式なりで調整して下さい）
End If
Next
End If
Next
End With
End Sub
ちなみに、質問者さんの提示されたコードは一切見ておりません。 ですから、そこへ反映することはそちらの責任で実行してください。 （どんな仕様で質問されたかも不明、しかも間違っている可能性もあるものを 好き好んで解析する人はいないと思います。）
一般論として言えば、ChatGPTは正確性が担保されているものではないで、 結果を検証できる力がなければ使えないと思います。 ですから、「言語はわかりません」というかたが使うのには限界があります。 並行してVBAを学習しなければならないことは当然のことです。
（xyz） 2023/07/26(水) 16:30:24
【特A貼】シート（転記元）のレイアウト
______C_____ ... ______E______ ... _G_ ... __K__ __L__ ・・・
1 FZ048AU440-2 C6-0030A-0004 35 48800
2 DZ345BC581-3 C9-5610A-0022 491 48838 48839
3 FZ010AJG69-1 C5-2000A-1002 381
4 DZ149AWA18-2 C5-5310A-1002 172 48838 48839
5 FZ048AU440-2 C6-0030A-0004 746 48829 48830
6 Z034BG748-2 C4-9880A-1003 381 48871 48881
7 FZ022BH402-2 C5-0710A-1008 312 48828
【特A】シート（転記先）のレイアウト★処理前★
______A_____ ... ______C______ __D__ __E__ ______F_______
4 品名 単価コート゛No 48800 48838 48839
5 作業内容 組立 PINフリ ハズシタイバー
6 単価 21.01 3.11 8.22
7 取数 1 1 1
8 FZ048AU440-2 C6-0030A-0004 9 DZ345BC581-3 C9-5610A-0022 10 FZ010AJG69-1 C5-2000A-1002 11 DZ149AWA18-2 C5-5310A-1002 12 FZ048AU440-2 C6-0030A-0004 13 FZ034BG748-2 C4-9880A-1003 14 FZ022BH402-2 C5-0710A-1008
＝＝＝＝＝＝＝＝＝＝＝ ↓ 処理 ↓ ＝＝＝＝＝＝＝＝＝＝＝
【特A】シート（転記先）のレイアウト★処理後★
______A_____ ... ______C______ __D__ __E__ ______F_______
4 品名 単価コート゛No 48800 48838 48839
5 作業内容 組立 PINフリ ハズシタイバー
6 単価 21.01 3.11 8.22
7 取数 1 1 1
8 FZ048AU440-2 C6-0030A-0004 (35) 9 DZ345BC581-3 C9-5610A-0022 (491) (491) 10 FZ010AJG69-1 C5-2000A-1002 11 DZ149AWA18-2 C5-5310A-1002 (172) (172) 12 FZ048AU440-2 C6-0030A-0004 (35) 13 FZ034BG748-2 C4-9880A-1003 14 FZ022BH402-2 C5-0710A-1008
上記のような話であれば、ちょっと複雑にはなりますがマクロを使わなくてもできそうな気がします。
【特A】シート（転記先）のレイアウト★処理後★
______A_____ ... ______C______ ____D____ ____E____ __F__ __G__ __H__
4 品名 単価コート゛No 【作業列1】 【作業列2】 48800 48838 48839
8 FZ048AU440-2 C6-0030A-0004 9 DZ345BC581-3 C9-5610A-0022 10 FZ010AJG69-1 C5-2000A-1002 11 DZ149AWA18-2 C5-5310A-1002 12 FZ048AU440-2 C6-0030A-0004 13 FZ034BG748-2 C4-9880A-1003 14 FZ022BH402-2 C5-0710A-1008
【D8セル】=XLOOKUP(A8&"・"&C8,特A貼!C:C&"・"&特A貼!E:E,特A貼!G:G,"") 【E8セル】=IFERROR(MATCH(A8&"・"&C8,特A貼!C:C&"・"&特A貼!E:E,0)-1,"") 【F8セル】=IFERROR(IF(MATCH(F$4,OFFSET(特A貼!$K$1:$L$1,$E8,),0),$D8,""),"")
と入力して必要な部分に（フィル）コピー
F8以降の【表示形式】を「(0)」に設定
マクロでも同じ発想で↓のような処理をすればよいと思います。
1. (A列＆C列)をキーに、【特A】の何行目を見ればよいか調べる 2. ４行目の値が、「1.で調べた行」にあるかチェックする 3. ↑でヒットしたら、【特A】のＧ列「1.で調べた行」の値を転記する
※xyzさんのコードを読み込んでませんが、ざっと見る限り類似の発想になっているとおもいます。
（もこな２ ） 2023/07/26(水) 18:47:32
（NAOKI） 2023/07/26(水) 22:08:05
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.