エクセルVBA 表示について

質問

VBAにて次のようにしたいのですが、できますか？
今月処理だと５月ですので、５
そこにＡ１から下方向へ１～通し番号が振ってあります。
sheet2に転記する際に、０５０００１、０５０００２、０５０００３というようにしたいのです。１２月なら１２０００１、１２０００２、１２０００３と言う様にしたいです。できますか？

回答No.3

at121 · ベストアンサー

[Sheet2に転記]が"目的"なのか読めないので・・ただの連番生成 and 変換手段

------生成(上書き)--------------------

Sub A列に月2桁と4桁連番生成()
Dim 判定セル As Range
'判定　B列入力有効のセル
見出し行 = 2 '見出し行除外
連番数字 = 1
For Each 判定セル In Columns(2).SpecialCells(xlCellTypeConstants)
If 判定セル.Row > 見出し行 Then
数字4桁 = Format(連番数字, "0000")
判定セル.Offset(0, -1) = "'" & Format(Now, "YY" & 数字4桁)
連番数字 = 連番数字 + 1
End If
Next
End Sub

-----変換---------------------------

Sub A列まとめて連番変換()
Dim 連番セル As Range
For Each 連番セル In Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
連番セル = "'" & 連番⇒月2桁と4桁連番(連番セル.Value)'文字形式化
Next
End Sub

Function 連番⇒月2桁と4桁連番(連番数字)
連番⇒月2桁と4桁連番 = ""
If Not IsNumeric(連番数字) Or IsEmpty(連番数字) Then Exit Function

数字4桁 = Format(連番数字, "0000")
連番⇒月2桁と4桁連番 = Format(Now, "YY" & 数字4桁)

End Function

回答No.2

Wendy02

こんなのはいかがでしょうか？
ただし、データは、全角でないと思っていますが。

Sub test_copy()
　Dim ThisMonth As Integer
　Dim myData As Variant
　Dim i As Long
　Dim CheckNum As Long
　ThisMonth = Month(Date)
　Application.ScreenUpdating = False
　With Worksheets("Sheet1")
　　.Select
　　myData = .Range("A1", Range("A65536").End(xlUp)).Value
　End With
　CheckNum = UBound(myData, 1) 'データ数
　'最大値を調べる
　CheckNum = Application.Min(CheckNum, 9999)　'最大9999
　With Worksheets("Sheet2")
　　.Range("A1").Resize(CheckNum).NumberFormat = "@"
　　For i = 1 To CheckNum
　　　.Cells(i, 1).Value = Format$(myData(i, 1) + _
　　　ThisMonth * 10 ^ 4, "000000")
　　Next i
　End With
　Application.ScreenUpdating = True
End Sub

回答No.1

ctrlzr

通し番号をいくつまでにしたいのかわからないので、とりあえず一番下までです。（万までいくと桁数が増えます）
しかも試してないです(^^ゞ

dim v
dim sh as worksheet
dim i as long
dim m as string

set sh=worksheets("sheet2")
m = StrConv(format$(month(date),"00"),vbWide)

v = sh.Columns("A:A").Value
for i=1 to 65536
v(i,1)= m & StrConv(format$(i,"0000"),vbWide)
next

sh.Columns("A:A").value = v