|
▼℃素人 さん:
>ですが、もともとのデータ(この場合A列にある)の株式会社ABCD(XYZ有限会社様向)とある(XYZ有限会社様向)を削除したいのですがどうしたらいいでしょう?
変更点が結構あるので、どこがどう変わっているのか、
ByRefって?なんでFunctionからSubになったのか?を理解して使ってください。
Option Explicit
Public Sub test()
Dim endRow As Long
Dim i As Long
Dim fromCompany As String
Dim toCompany As String
' A列の最終行を取得
endRow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
' 1行目から最終行まで処理
For i = 1 To endRow
With Worksheets("Sheet1").Cells(i, 1)
' A列の文字列から会社名の取得
Call GetCompanyInfo(.Value, fromCompany, toCompany)
' 各セルに反映
.Value = fromCompany
.Offset(, 1).Value = toCompany
End With
Next
End Sub
' 文字列の後の括弧を元に、会社名を取得する関数
Private Sub GetCompanyInfo(ByVal text As String, _
ByRef fromCompany As String, _
ByRef toCompany As String)
Dim startPos As Long
Dim endPos As Long
' 終了括弧の位置
endPos = InStrRev(text, ")")
If endPos <> 0 Then
' 開始括弧の位置
startPos = InStrRev(text, "(", endPos)
If startPos <> 0 Then
' 括弧の中身を取得
toCompany = Mid$(text, startPos + 1, endPos - startPos - 1)
' 括弧の前を取得
fromCompany = Left$(text, startPos - 1)
End If
End If
End Sub
|
|