| |
こんなのでも？
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRows As Long
Dim vntData As Variant
Dim lngPos As Long
Dim strProm As String
'データの有るシートにA1を基準とする
With ActiveSheet.Cells(1, "A")
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'データを配列に取得
vntData = .Offset(1).Resize(lngRows).Value
'データ全てに就いて繰り返し
For i = 1 To lngRows
'"*"の位置を取得（全角、半角を問わずの場合）
lngPos = InStr(1, vntData(i, 1), "*", vbTextCompare)
'"*"の位置を取得（"*"と同じ物のみを指定する場合、）
' lngPos = InStr(1, vntData(i, 1), "*", vbBinaryCompare)
'"*"が有った場合
If lngPos > 0 Then
'"*"因り、左部分を取得
vntData(i, 1) = Left(vntData(i, 1), lngPos - 1)
End If
Next i
'結果を隣りの列に出力
.Offset(1, 1).Resize(lngRows).Value = vntData
End With
strProm = "処理が完了しました"
Wayout:
Beep
MsgBox strProm
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 05/9/15(木) 19:56 -
