2022-09-06

セル書式を書き出す

例題

この表の各セルの書式を赤い罫線内に書き出す

A列：文字列（A4のみ標準）、B列：数値、C列：通貨

1行目はタイトルなので値をコピー

Dim lngMaxRow As Long
Dim lngMaxCol As Long

Dim i As Integer
Dim j As Integer

'表内最大行を取得
lngMaxRow = lngGetMaxRow(ActiveSheet)

'表内最大列を取得
lngMaxCol = lngGetMaxCol(ActiveSheet)


For i = 1 To lngMaxRow '最大行まで繰り返す

For j = 1 To lngMaxCol '最大列まで繰り返す

If i = 1 Then
'1行目はタイトルなので値をコピー
ActiveSheet.Cells(i, j + 5).Value = ActiveSheet.Cells(i, j).Value
Else
'2行目以降は1セルずつ書式を記述する（5列先）
Call WriteRangeFormat(ActiveSheet.Cells(i, j), ActiveSheet.Cells(i, j + 5))
End If

Next j

Next i

【呼び出し関数】

'------------------------------------------------------
'セルの書式設定を書き出す
'
' 戻値：なし
'
' 引数：コピー元セル（範囲指定は不可）
' ：コピー先セル（範囲指定可）
'
' 注意：コピー元セルが複数指定されている場合エラーとする
'-------------------------------------------------------
Sub WriteRangeFormat(rngMoto As Range, rngSaki As Range)

If rngMoto.Count > 1 Then

'エラー処理を行う（ログを出す、セルを色づけする等）

Exit Sub

End If

rngSaki.Value = rngMoto.NumberFormatLocal

End Sub

【結果】

2022-09-05

For Nextを使って表をコピー

例題

この表を赤い罫線内にコピーする

Dim lngMaxRow As Long
Dim lngMaxCol As Long

Dim i As Integer
Dim j As Integer

'表内最大行を取得
lngMaxRow = lngGetMaxRow(ActiveSheet)

'表内最大列を取得
lngMaxCol = lngGetMaxCol(ActiveSheet)


For i = 1 To lngMaxRow '最大行まで繰り返す

For j = 1 To lngMaxCol '最大列まで繰り返す

'5列先に1セルずつコピーする
ActiveSheet.Cells(i, j + 5).Value = ActiveSheet.Cells(i, j).Value

Next j

Next i

【結果】

2022-09-03

セルの書式をコピー＆ペースト

作成関数

'------------------------------------------------------
'セルの書式設定をコピー
'
' 戻値：なし
'
' 引数：コピー元セル（範囲指定は不可）
' ：コピー先セル（範囲指定可）
'
' 注意：コピー元セルが複数指定されている場合エラーとする
'-------------------------------------------------------
Sub CopyRangeFormat(rngMoto As Range, rngSaki As Range)

If rngMoto.Count > 1 Then

'エラー処理を行う（ログを出す、セルを色づけする等）

Exit Sub

End If

rngSaki.NumberFormatLocal = rngMoto.NumberFormatLocal

End Sub

呼び出し方

'A1の書式設定をB1にコピー
Call CopyRangeFormat(Range("A1"), Range("B1"))

'A1セルの書式設定を複数セルにコピー
Call CopyRangeFormat(Range("A1"), Range("B1:B10"))

2022-09-02

表内最終列を取得

作成関数

'------------------------------------------------------
'表内最大列を取得
'
' 戻値：表内最大列
'
' 引数：対象ワークシート
' ：カウント基準となる行（省略時：1（1行目））
'
' 注意：オートフィルター、非表示は解除してから行うこと
'-------------------------------------------------------
Function lngGetMaxCol(wsWorksheet As Worksheet, Optional lngCountBaseRow As Long = 1) As Long

Dim lngMaxCol As Long

lngMaxCol = wsWorksheet.Cells(lngCountBaseRow, Columns.Count).End(xlToLeft).Column 'シート最大列からCtrl+←で表内最大列取得

lngGetMaxCol = lngMaxCol

End Function

2022-09-02

表内最終行を取得

作成関数

'------------------------------------------------------
'表内最終行を取得
'
' 戻値：表内最終行
'
' 引数：対象ワークシート
' ：カウント基準となる列（省略時：1（A列））
'
' 注意：オートフィルター、非表示は解除してから行うこと
'-------------------------------------------------------
Function lngGetMaxRow(wsWorksheet As Worksheet, Optional lngCountBaseCol As Long = 1) As Long

Dim lngMaxRow As Long

lngMaxRow = wsWorksheet.Cells(Rows.Count, lngCountBaseCol).End(xlUp).Row 'シート最大行からCtrl+↑で表内最大行取得

lngGetMaxRow = lngMaxRow

End Function