文字変換マクロについて

質問

数値を文字列に変換するマクロで、行数や列数が増えても対応できるようにしたいです。
（並びは…数値　スペース　文字列）どなたか教えてください。
よろしくお願いします。
Sub 文字()
Dim i As Long
For i = 1 To Range("A1").End(xlDown).Row
Cells(i, "C") = Cells(i, "A")
With Cells(i, "C")
.NumberFormatLocal = "@"
.Value = StrConv(Cells(i, "C").Value, vbNarrow)
.Value = Format(Cells(i, "C").Value, "'00")
End With
Next i
End Sub

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.1

kkkkkm · ベストアンサー

こんな感じでしょうか。
ループの回数指定にEnd(xlDown).Rowを使うのはその列の2行目以降にデータがない場合最大行数が返って怖いのでEnd(xlUp).Rowにしています。下にデータがある場合はRows.Countを下のデータの一行上に指定するか、もとのEnd(xlDown).Rowを利用してください。

同じように列方向もEnd(xlToLeft).Columnにしています。

Sub 文字()
Dim i As Long, j As Long, k As Integer

j = Cells(1, Columns.Count).End(xlToLeft).Column
Debug.Print j
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, j + 2).Resize(1, j).Value = Cells(i, "A").Resize(1, j).Value
For k = 1 To j
With Cells(i, k + j + 1)
.NumberFormatLocal = "@"
.Value = StrConv(Cells(i, k + j + 1).Value, vbNarrow)
.Value = Format(Cells(i, k + j + 1).Value, "'00")
End With
Next k
Next i
End Sub

お礼

回答ありがとうございました。助かりました。

回答No.3

kagakusuki

回答no.2です。
　他にも、繰り返し処理を使わずに、ワークシート関数を使って一気に値を算出させてから、得られた値のみを同じセル範囲に入力しなおすという方法もあります。

Sub QNo9233753_文字変換マクロについて_2()

Const FirstCell = "A1"
Dim myRange As Range, myOffset As Long

With Range(FirstCell)
myOffset = Range(.Offset(0), Cells(.row, Columns.Count).End(xlToLeft)).Columns.Count
Set myRange = Range(.Offset(0), Cells(Rows.Count, .column).End(xlUp)).Resize(, myOffset).Offset(, myOffset + 1)
End With
myOffset = myOffset + 1

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

With myRange
.FormulaR1C1 = "=IF(RC[-" & myOffset & "]="""","""",TEXT(RC[-" & myOffset & "],""00""))"
.Parent.Calculate
.NumberFormatLocal = "@"
.Value = .Value
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

回答No.2

kagakusuki

For ～ To ～ NextではなくFor Each ～ in ～ Nextを使って繰り返し処理をされると良いです。

Sub QNo9233753_文字変換マクロについて()

Const FirstCell = "A1"
Dim c As Range, myRange As Range, myOffset As Long

With Range(FirstCell)
myOffset = Range(.Offset(0), Cells(.row, Columns.Count).End(xlToLeft)).Columns.Count
Set myRange = Range(.Offset(0), Cells(Rows.Count, .column).End(xlUp)).Resize(, myOffset)
End With
myOffset = myOffset + 1

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

myRange.Offset(, myOffset).NumberFormatLocal = "@"
For Each c In myRange
c.Offset(, myOffset).Value = Format(c.Value, "00")
Next c

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

　因みに上記のVBAの中の

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

という箇所と

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

という箇所は処理を高速化するために設けているものですので、もし処理速度が若干遅くなっても良い場合には、次の様に簡略化してしまっても構いません。

Sub QNo9233753_文字変換マクロについて()

Const FirstCell = "A1"
Dim c As Range, myRange As Range, myOffset As Long

With Range(FirstCell)
myOffset = Range(.Offset(0), Cells(.row, Columns.Count).End(xlToLeft)).Columns.Count
Set myRange = Range(.Offset(0), Cells(Rows.Count, .column).End(xlUp)).Resize(, myOffset)
End With
myOffset = myOffset + 1

myRange.Offset(, myOffset).NumberFormatLocal = "@"
For Each c In myRange
c.Offset(, myOffset).Value = Format(c.Value, "00")
Next c

End Sub

お礼

できました。解説ありがとうございました。