|
こんなのでも善いかも
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntData As Variant
Dim strProm As String
'◆"県名"の在るセルを探しそれを基準とする(列見出しのセル位置)
Set rngList = ActiveSheet.Cells.Find(What:="県名", LookIn:=xlValues, LookAt:=xlWhole)
'該当セルが無ければ終了
If rngList Is Nothing Then
strProm = "該当セルが有りません"
GoTo Wayout
End If
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'列データを配列に取得
vntData = .Offset(1).Resize(lngRows + 1).Value
End With
'列に就いて繰り返し
For i = 1 To lngRows
'"県"を ""に置き換え
vntData(i, 1) = Replace(vntData(i, 1), "県", "", , , vbBinaryCompare)
Next i
'画面更新を停止
Application.ScreenUpdating = False
'結果出力
rngList.Offset(1).Resize(lngRows).Value = vntData
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|