|
Option Explicit
Public Sub Sample1()
'◆データベースのデータ列数(A列)
Const clngColumns As Long = 1
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData As Variant
Dim strResult() As String
Dim strProm As String
'◆Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
Set rngList = ActiveSheet.Cells(1, "A")
'◆出力先の先頭セル位置を基準とする(C列の列見出しのセル位置)
Set rngResult = rngList.Parent.Cells(1, "C")
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
'画面更新を停止
Application.ScreenUpdating = False
With rngResult
For i = 1 To lngRows
strResult = Split(vntData(i, 1), "-", , vbBinaryCompare)
.Offset(i).Resize(, UBound(strResult) + 1).Value = strResult
Next i
End With
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
Public Sub Sample2()
'◆データベースのデータ列数(A列〜C列)
Const clngColumns As Long = 3
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData As Variant
Dim strResult As String
Dim strProm As String
'◆Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
Set rngList = ActiveSheet.Cells(1, "A")
'◆出力先の先頭セル位置を基準とする(C列の列見出しのセル位置)
Set rngResult = rngList.Parent.Cells(1, "E")
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, 3).Value
End With
'画面更新を停止
Application.ScreenUpdating = False
With rngResult
For i = 1 To lngRows
' strResult = vntData(i, 1) & "-" & vntData(i, 2) & "-" & vntData(i, 3)
strResult = Format(vntData(i, 1), "00") _
& "-" & Format(vntData(i, 2), "00") _
& "-" & Format(vntData(i, 3), "00")
.Offset(i).Value = strResult
Next i
End With
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
|
|