使い方
- セル範囲を選ぶ
- マクロを実行する
機能
- rangeSimplifyToColumn
表形式から一列形式に変換。 - rangeSimplifyToRow
表形式から一行形式に変換。 - rangeColumnToRange
一列形式から表形式に変換。 - rangeRowToRange
一行形式から表形式に変換。 - rangeTranspose
転置(表形式の縦横を入れ替える。)
コード
ちょっと長いですが、やっていることはとてもシンプル。もっと上手い実装の仕方がありそうな気もする…
Sub rangeSimplifyToColumn() Dim sourceRange As Range Dim returnRange As Range Dim rowCount As Integer 'セル範囲を1つだけ選択している場合しか動作しないようにする。 If Not TypeName(Selection) = "Range" Then Exit Sub If Not Selection.Areas.Count = 1 Then Exit Sub Set sourceRange = Selection '値を返す範囲を作る With sourceRange rowCount = .Rows.Count Set returnRange = Range(.Cells(1, 1), .Cells(1, 1).Offset(.Cells.Count - 1, 0)) End With '値を代入する For i = 1 To sourceRange.Columns.Count With returnRange Range(.Cells((i - 1) * rowCount + 1, 1), .Cells(i * rowCount, 1)).Value = sourceRange.Columns(i).Value End With Next '不要な値を削除する With sourceRange Range(.Columns(2), .Columns(.Columns.Count)).ClearContents End With '出力した範囲を選択する returnRange.Select End Sub Sub rangeSimplifyToRow() Dim sourceRange As Range Dim returnRange As Range Dim colCount As Integer 'セル範囲を1つだけ選択している場合しか動作しないようにする。 If Not TypeName(Selection) = "Range" Then Exit Sub If Not Selection.Areas.Count = 1 Then Exit Sub Set sourceRange = Selection '値を返す範囲を作る With sourceRange colCount = .Columns.Count Set returnRange = Range(.Cells(1, 1), .Cells(1, 1).Offset(0, .Cells.Count - 1)) End With '値を代入する For i = 1 To sourceRange.Rows.Count With returnRange Range(.Cells(1, (i - 1) * colCount + 1), .Cells(1, i * colCount)).Value = sourceRange.Rows(i).Value End With Next '不要な値を削除する With sourceRange Range(.Rows(2), .Rows(.Rows.Count)).ClearContents End With '出力した範囲を選択する returnRange.Select End Sub Sub rangeColumnToRange() Dim sourceRange As Range Dim returnRange As Range Dim rowCount As Integer 'セル範囲を1列だけ選択している場合しか動作しないようにする。 If Not TypeName(Selection) = "Range" Then Exit Sub If Not Selection.Areas.Count = 1 Then Exit Sub If Not Selection.Columns.Count = 1 Then Exit Sub Set sourceRange = Selection rowCount = CInt(Application.InputBox(Prompt:="Input number of rows =", Title:="rangeColumnToRange", Type:=1)) '割り切れないときの処理 '値を返す範囲を作る With sourceRange Set sourceRange = Range(.Cells(1), .Cells(.Cells.Count).Offset(.Cells.Count Mod rowCount)) End With With sourceRange 'sourceRangeをwith sourceRangeの中で更新した場合、Withを分けるか直接指定する必要あり Set returnRange = Range(.Cells(1, 1), .Cells(rowCount, 1).Offset(0, Int(.Cells.Count / rowCount) - 1)) End With '値を代入する For i = 1 To returnRange.Columns.Count With sourceRange returnRange.Columns(i).Value = Range(.Cells((i - 1) * rowCount + 1, 1), .Cells(i * rowCount, 1)).Value End With Next '不要な値を削除する With sourceRange Range(.Rows(rowCount + 1), .Rows(.Rows.Count)).ClearContents End With '出力した範囲を選択する returnRange.Select End Sub Sub rangeRowToRange() Dim sourceRange As Range Dim returnRange As Range Dim colCount As Integer 'セル範囲を1つだけ選択している場合しか動作しないようにする。 If Not TypeName(Selection) = "Range" Then Exit Sub If Not Selection.Areas.Count = 1 Then Exit Sub If Not Selection.Rows.Count = 1 Then Exit Sub Set sourceRange = Selection colCount = CInt(Application.InputBox(Prompt:="Input number of colmuns =", Title:="rangeRowToRange", Type:=1)) '割り切れないときの処理 '値を返す範囲を作る With sourceRange Set sourceRange = Range(.Cells(1), .Cells(.Cells.Count).Offset(.Cells.Count Mod colCount)) End With With sourceRange 'sourceRangeをwith sourceRangeの中で更新した場合、Withを分けるか直接指定する必要あり Set returnRange = Range(.Cells(1, 1), .Cells(1, colCount).Offset(Int(.Cells.Count / colCount) - 1, 0)) End With '値を代入する For i = 1 To returnRange.Rows.Count With sourceRange returnRange.Rows(i).Value = Range(.Cells(1, (i - 1) * colCount + 1), .Cells(1, i * colCount)).Value End With Next '不要な値を削除する With sourceRange Range(.Columns(colCount + 1), .Columns(.Columns.Count)).ClearContents End With '出力した範囲を選択する returnRange.Select End Sub Sub rangeTranspose() Dim returnRange As Range Dim sourceValue As Variant 'セル範囲を1つだけ選択している場合しか動作しないようにする。 If Not TypeName(Selection) = "Range" Then Exit Sub If Not Selection.Areas.Count = 1 Then Exit Sub sourceValue = Selection.Value '値を返す範囲を作成 With Selection Set returnRange = Range(.Cells(1, 1), .Cells(1, 1).Offset(.Columns.Count - 1, .Rows.Count - 1)) End With 'いらないデータを消去 Selection.ClearContents '転置して出力する returnRange.Value = Application.WorksheetFunction.Transpose(sourceValue) returnRange.Select End Sub
No comments :
Post a Comment