前提・実現したいこと
VBAの「検索」ボタン押下により、マスタデータに存在する検索結果を一覧シートに転記したいのですが、該当のデータが複数存在する場合に、上書きで転記されてしまいます。
Do~Loop内のコードが誤っていると思うのですが、解決策にたどり着きません。
ご教示いただけましたら幸いです。
発生している問題・エラーメッセージ
変数LastRowの値が、Do~Loop内で更新されず、上書きされてしまう。
VBA
1Option Explicit 2 3 Dim ID As Integer 4 Dim Name_F As String 5 Dim Name_L As String 6 Dim Role As String 7 Dim Year_E As Integer 8 Dim Month_E As Integer 9 Dim Day_E As Integer 10 Dim Year_L As Integer 11 Dim Month_L As Integer 12 Dim Day_L As Integer 13 Dim Experience As String 14 Dim Language_1 As String 15 Dim Language_2 As String 16 Dim Language_3 As String 17 Dim Language_4 As String 18 19 20 Const Col_ID = "A" 21 Const Col_Name_F = "B" 22 Const Col_Name_L = "C" 23 Const Col_Role = "D" 24 Const Col_Year_E = "E" 25 Const Col_Month_E = "F" 26 Const Col_Day_E = "G" 27 Const Col_Year_L = "H" 28 Const Col_Month_L = "I" 29 Const Col_Day_L = "J" 30 Const Col_Experience = "K" 31 Const Col_Language_1 = "L" 32 Const Col_Language_2 = "M" 33 Const Col_Language_3 = "N" 34 Const Col_Language_4 = "O" 35 36Sub Kensaku_Click() 37 38 '変数宣言 39 Dim sht_toroku As Worksheet 40 Dim sht_shain As Worksheet 41 Dim sht_itiran As Worksheet 42 Dim FoundCell As Range 43 Dim LastRow As Integer 44 Dim FirstCell As Range 45 46 Set sht_toroku = Worksheets("社員情報管理_登録") 47 Set sht_shain = Worksheets("社員マスタ") 48 Set sht_itiran = Worksheets("社員情報一覧") 49 LastRow = sht_itiran.Cells(Rows.Count, 2).End(xlUp).Row + 1 50 51 '1件目の社員マスタ内のデータを検索 52 Set FoundCell = sht_shain.Range("A2:O1000").Find(sht_toroku.Range("E3").Value) 53 54 If FoundCell Is Nothing Then 55 MsgBox "検索対象が見つかりませんでした。" 56 Exit Sub 57 Else 58 Set FirstCell = FoundCell 59 60 '社員マスタシートの情報を取得_1件目 61 Call getShainData(sht_shain, FoundCell) 62 63 '取得したデータを社員一覧シートに転記_1件目 64 Call outShainData(sht_itiran, LastRow) 65 End If 66 67 'ループ Start 68 Do 69 '次の条件に合致するデータの検索 70 Set FoundCell = sht_shain.Cells.FindNext(FoundCell) 71 72 '検索条件に合致するデータを検索し終わった場合、終了 73 If FoundCell.Address = FirstCell.Address Then 74 Exit Do 75 Else 76 '社員マスタシートの情報を取得_2件目以降 77 Call getShainData(sht_shain, FoundCell) 78 79 '取得したデータを社員一覧シートに転記_2件目以降 80 Call outShainData(sht_itiran, LastRow) 81 End If 82 Loop 83End Sub 84 85Sub getShainData(sht_shain As Worksheet, FoundCell As Range) 86 87 ID = sht_shain.Cells(FoundCell.Row, Col_ID).Value 88 Name_F = sht_shain.Cells(FoundCell.Row, Col_Name_F).Value 89 Name_L = sht_shain.Cells(FoundCell.Row, Col_Name_L).Value 90 Role = sht_shain.Cells(FoundCell.Row, Col_Role).Value 91 Year_E = sht_shain.Cells(FoundCell.Row, Col_Year_E).Value 92 Month_E = sht_shain.Cells(FoundCell.Row, Col_Month_E).Value 93 Day_E = sht_shain.Cells(FoundCell.Row, Col_Day_E).Value 94 Year_L = sht_shain.Cells(FoundCell.Row, Col_Year_L).Value 95 Month_L = sht_shain.Cells(FoundCell.Row, Col_Month_L).Value 96 Day_L = sht_shain.Cells(FoundCell.Row, Col_Day_L).Value 97 Experience = sht_shain.Cells(FoundCell.Row, Col_Experience).Value 98 Language_1 = sht_shain.Cells(FoundCell.Row, Col_Language_1).Value 99 Language_2 = sht_shain.Cells(FoundCell.Row, Col_Language_2).Value 100 Language_3 = sht_shain.Cells(FoundCell.Row, Col_Language_3).Value 101 Language_4 = sht_shain.Cells(FoundCell.Row, Col_Language_4).Value 102 103End Sub 104 105Sub outShainData(sht_itiran As Worksheet, LastRow As Integer) 106 107 sht_itiran.Range("A" & LastRow).Value = ID 108 sht_itiran.Range("B" & LastRow).Value = Name_F 109 sht_itiran.Range("C" & LastRow).Value = Name_L 110 sht_itiran.Range("D" & LastRow).Value = Role 111 sht_itiran.Range("E" & LastRow).Value = Year_E 112 sht_itiran.Range("F" & LastRow).Value = Month_E 113 sht_itiran.Range("G" & LastRow).Value = Day_E 114 sht_itiran.Range("H" & LastRow).Value = Year_L 115 sht_itiran.Range("I" & LastRow).Value = Month_L 116 sht_itiran.Range("J" & LastRow).Value = Day_L 117 sht_itiran.Range("K" & LastRow).Value = Experience 118 sht_itiran.Range("L" & LastRow).Value = Language_1 119 sht_itiran.Range("M" & LastRow).Value = Language_2 120 sht_itiran.Range("N" & LastRow).Value = Language_3 121 sht_itiran.Range("O" & LastRow).Value = Language_4 122 123End Sub
試したこと
ここに問題に対して試したことを記載してください。
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/05/13 04:24