こんにちは〜ららぽてすらです♪
今日は会社で、２つのフル名前データから姓が変わってて名だけ一緒のデータを抽出する高精度vba作ったので紹介します🙆
⭐️ソースコード⭐️
Sub ComparePartialNames()
' Define variables
Dim ws As Worksheet
Dim rng As Range
Dim i As Long
Dim nameC As String
Dim nameI As String
Dim firstNameC As String
Dim firstNameI As String
Dim lenC As Integer
Dim lenI As Integer
' Set your worksheet
Set ws = ThisWorkbook.Sheets("Sheet5")
' Set the range you want to look through
' In this case, we assume data starts from row 2, to avoid headers
' This will loop until the last row of data in column C
LastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
' Loop through each cell in the range
For i = 2 To LastRow
' Convert cell values to string
nameC = CStr(ws.Cells(i, "C").Value)
nameI = CStr(ws.Cells(i, "I").Value)
' Get the lengths of the names
lenC = Len(nameC)
lenI = Len(nameI)
' Extract the last 1 to 3 characters of the names, depending on their lengths
firstNameC = Mid(nameC, IIf(lenC >= 3, lenC - 2, 1))
firstNameI = Mid(nameI, IIf(lenI >= 3, lenI - 2, 1))
' Check if the extracted parts of the names match
If firstNameC = firstNameI Then
' If they match, put a mark in column P
ws.Cells(i, "P").Value = "〇"
End If
Next i
End Sub
⭐️ソースコード解説⭐️
Sub ComparePartialNames()
この行は、新しいサブプロシージャ（関数ではない）を定義しています。このプロシージャの名前は「ComparePartialNames」です。
' Define variables
Dim ws As Worksheet
Dim rng As Range
Dim i As Long
Dim nameC As String
Dim nameI As String
Dim firstNameC As String
Dim firstNameI As String
Dim lenC As Integer
Dim lenI As Integer
これらの行では、プロシージャで使用する変数を宣言します。Worksheet、Range、Long、String、およびInteger型の変数があります。
' Set your worksheet
Set ws = ThisWorkbook.Sheets("Sheet5")
この行では、wsというWorksheet型の変数にThisWorkbookオブジェクトの"Sheet5"という名前のシートを代入しています。
' Set the range you want to look through
' In this case, we assume data starts from row 2, to avoid headers
' This will loop until the last row of data in column C
LastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
この行では、データがある最後の行を取得しています。このコードでは、wsオブジェクト（ワークシート）の最下行から上方向に探索し、最初に見つけたデータがある行を取得しています。これにより、列Cの最後の行が取得されます。
' Loop through each cell in the range
For i = 2 To LastRow
この行はForループを開始しています。このループは2行目から最終行まで繰り返されます。
' Convert cell values to string
nameC = CStr(ws.Cells(i, "C").Value)
nameI = CStr(ws.Cells(i, "I").Value)
これらの行では、各行のC列とI列の値を文字列に変換し、変数nameCとnameIにそれぞれ格納しています。
' Get the lengths of the names
lenC = Len(nameC)
lenI = Len(nameI)
ここでは、Len関数を使用して、nameCとnameIの長さを取得し、それぞれlenCとlenIに格納しています。
' Extract the last 1 to 3 characters of the names, depending on their lengths
firstNameC = Mid(nameC, IIf(lenC >= 3, lenC - 2, 1))
firstNameI = Mid(nameI, IIf(lenI >= 3, lenI - 2, 1))
これらの行では、Mid関数を使用して名前から一部の文字を抽出します。名前が3文字以上の場合は最後の3文字を、それ以外の場合は最初の文字から抽出します。
' Check if the extracted parts of the names match
If firstNameC = firstNameI Then
ここでは、抽出した部分的な名前が一致するかどうかをチェックします。
' If they match, put a mark in column P
ws.Cells(i, "P").Value = "〇"
もし部分的な名前が一致するなら、列Pにマークをつけます。
End If
If文の終わりを示しています。
Next i
Forループの終わりを示しています。この行に到達すると、iが次の値に増え、Forループが再度実行されます。
End Sub
サブプロシージャの終わりを示しています。これがあることで、このサブプロシージャがどこで終わるかが明確になります。
 |
有機 あずき美人茶 ペットボトル 500mL 12本セット【送料無料】【有機JAS認定】 価格:3,240円 |
 |
《2000円クーポン配布中》 ヤ−マン アセチノ5Dデザイニングクリーム 35g ボディクリーム 美容クリーム スキンケア アセチノクリーム アセチノ美容クリーム 価格:3,980円 |
