Excel VBA セル操作

Excel VBA のトップに戻る
Excel VBA 目次

Excelの最終行を取得
行列処理
 ・同上の補完
 ・変数を使って、セルを指定する方法
セル範囲を、配列に一括登録、およびその逆
行列入れ替えコピー
 ・連立1次方程式の解
 ・子供の血液型の出現率
Excel関数の VLOOKUP をマクロで
選択範囲を取得し、A1形式で表示
セルのデータチェック
セルの文字検索と置換
セルデータの集計と文字検索
並び替え+重複行削除
使っている全てのセルを指定する

複数シートを串刺し集計(3D集計)
セルの範囲を連続コピー
キーのトップと属性の重複を摘出

索引


複数シートを串刺し集計(3D集計)

 一つのブックに、例えば、各支店の月別売上金額のそれぞれのシートがあったときに、全支店の月別売上金額を集計した、合計シートを作りたいことが有ります。
 こんな時に使うものが、串刺し集計(3D集計) です。

 VBA のコードでは、以下の形式になります。

"=SUM('" & "パス(例 D:\temp\マクロ事例\)" & "[ブック名(例:テストVBA1.xls)]" & "左端シート名(例:北海道支店)" & ":" & "右端シート名(例:鹿児島支店)" & "'!" & "対象セル" & ")"

 これを、Range に代入します。
 次の例は、シート 1 のセル A1 に数式を設定する例です。

Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10"

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


セルの範囲を連続コピー

 セルの範囲を、連続したセルの範囲にコピーしたいことが有ります。
 こんなときには、AutoFill メソッドを使います。

 解説:
 AutoFill メソッドは、指定された対象セル範囲内のセルに対してオートフィルを実行します。バリアント型 (Variant) の値を使用します。
expression.AutoFill(Destination, Type)
 expression 必ず指定します。対象となるオブジェクトへの参照を返すオブジェクト式を指定します。
 Destination 必ず指定します。オートフィルの書き込み先になる Range オブジェクトを指定します。基準となるデータの入ったセル範囲も含むようにします。
 Type 省略可能です。XlAutoFillType クラスの定数を使用します。リストの種類を指定します。
 使用できる定数は、次に示す XlAutoFillType クラスのいずれかです。
xlFillDays xlFillFormats xlFillSeries xlFillWeekdays xlGrowthTrend xlFillCopy xlFillDefault (既定値) xlFillMonths xlFillValues xlFillYears xlLinearTrend
この引数に xlFillDefault を指定する、または省略すると、元になるセル範囲に応じて、最も適切な種類のリストが選択されます。

 次の例は、シート 1 のセル範囲 A1:A20 に対して、セル範囲 A1:A2 の値を基にしてオートフィルを実行します。この使用例を実行する前に、セル A1 には「1」、セル A2 には「2」を入力しておいてください。

Set sourceRange = Worksheets("Sheet1").Range("A1:A2")
Set fillRange = Worksheets("Sheet1").Range("A1:A20")
sourceRange.AutoFill Destination:=fillRange

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


キーのトップと属性の重複を摘出

 行方向に、重複を認めるキー(A列)と、その属性データ(B列)が並んでいるとき、指摘の列(C列)に、@.キーの最初の行(トップ)と、同一キーでの属性の重複(重複)を検出して表示します。

 マクロのファイルは、別のバージョンですが、指定ブック中の全てのシートで、指定列の「セルデータの重複」をチェック の CheckRepetitionInSheetVBA**.xls を、ダウンロードできます。

キー 属性 指摘
AAA トップ
AAA
AAA 重複
AAA
BBB トップ
BBB
BBB
BBB 重複
CCC トップ
CCC
CCC


Option Explicit
Option Base 1

Dim キー As String
Dim 前キー As String

Dim 処理行 As Long
Dim 最終行 As Long
Dim 属性 As String
Dim データ() As String
Dim 状況 As String
Dim 組合せ数 As Integer
Dim 検索行 As Integer

Private Sub 属性重複抽出()

   ThisWorkbook.Worksheets("データ").Activate
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

   For 処理行 = 1 To 最終行 + 1 'キーの変化を検出するため、一行余分に調べる

      状況 = ""
      キー = Range("A1").Cells(処理行, 1).Value
      
      If キー <> 前キー Then '直前行と比較して、キーのトップを検出
         Range("C1").Cells(処理行, 1).Value = "トップ"
         前属性 = 属性 'キーが変わったので、初期値を設定
         組合せ数 = 0
         Erase データ
      End If
      
      属性 = Range("B1").Cells(処理行, 1).Value
      If 属性 = "" Then GoTo 次の行へ
      
      組合せ数 = 組合せ数 + 1
      
      If 組合せ数 = 1 Then
         ReDim Preserve データ(組合せ数)
         データ(1) = 属性 '重複をチェックするため、配列に格納
         
      ElseIf 組合せ数 > 1 Then
      
         For 検索行 = 1 To 組合せ数 - 1 '登録済みの配列内容と照合して、合致したら重複として処置
             If データ(検索行) = 属性 Then
               Range("C1").Cells(処理行, 1).Value = "重複"
               組合せ数 = 組合せ数 - 1
               状況 = "重複"
               Exit For
             End If
         Next 検索行
         
         If 状況 = "" Then '重複していなければ、配列に格納
            ReDim Preserve データ(組合せ数)
            データ(組合せ数) = 属性
         End If
         
      End If
次の行へ:
   Next 処理行
End Sub

 解説:


この種類の目次に戻る↑ 索引へ↓ トップページに戻る


指定列のセルの値を、指定した方法で型変換して、指定したシートの指定した列に貼付ける

 ダウンロードして取得した Excel のデータなどには、列に登録されたデータの型が、不適切なことがあります。
 例えば、列に登録されたデータの形式が、「文字列」扱いになっているため、数値としてカンマ挿入できなかったり、日付けとして、書式を設定できなかったりすることがあります。
 あるいは、文字列の前後に、不要な空白が入っている場合もあります。
 これらを、列指定で、一括変換できるように、汎用ツールとして作りました。

このマクロをダウンロードできます。→TrimCastVBA01.xls

Option Explicit
Option Base 1

   Dim 最終行 As Long
   Dim 開始時刻 As Variant
   Dim 終了時刻 As Variant
   Dim 処理行 As Integer
   Dim コピー行数 As Integer
   Dim コピー元データ開始行 As Integer
   Dim コピー元ブック名 As String
   Dim コピー元シート名 As String
   Dim コピー元シート As Worksheet
   Dim 貼付け先ブック名 As String
   Dim 貼付け先シート名 As String
   Dim 貼付け先シート As Worksheet
   Dim 貼付け先データ開始行 As Integer
   Dim データ配列() As Variant
   Dim データ As Variant
   Dim コピー対象列 As String
   Dim 貼付け対象列 As String
   Dim コピー対象行数 As Integer
   Dim トリム処理 As Boolean
   Dim 型変換 As Integer
   Dim 配置 As Integer


Sub シートの指定列のデータを型変換してコピー()

   開始時刻 = Now()

   Call 処理指定とデータの読み込み

   Call 貼付け処理

   Set 貼付け先シート = Nothing

   終了時刻 = Now()

   MsgBox "処理が終了しました。" & Chr(13) & _
   "処理時間は、" & Format(終了時刻 - 開始時刻, "nn分ss秒") & " でした。", vbOKOnly
   
End Sub



Private Sub 貼付け処理()
   Dim 文字列 As String

   貼付け先シート.Activate
   For 処理行 = 1 To コピー対象行数
      If トリム処理 = True Then
         データ = Trim(データ配列(処理行, 1))
      Else
         データ = データ配列(処理行, 1)
      End If

      Select Case 型変換
         Case 1 '数値
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
               .NumberFormatLocal = "0_ "
         Case 2 '文字列
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
               .NumberFormatLocal = "@"
         Case 3 '日付:yyyymmdd
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
               .NumberFormatLocal = "yyyymmdd"
            文字列 = CStr(データ)
            文字列 = 正規表現で置換("([0-9]{4})([0-9]{2})([0-9]{2})", 文字列, "$1/$2/$3")
            データ = DateValue(文字列)

         Case 4 '日付:yyyy/mm/dd
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
               .NumberFormatLocal = "yyyy/mm/dd"
            データ = DateValue(データ)
      End Select

      Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
         .Value = データ


      Select Case 配置
         Case 1 '無指定

         Case 2 '左詰め
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
                 .HorizontalAlignment = xlLeft
         Case 3 '中央詰め
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
                 .HorizontalAlignment = xlCenter
         Case 4 '右詰め
            Range("A1").Cells(処理行 + 貼付け先データ開始行 - 1, 列番号(貼付け対象列)) _
                 .HorizontalAlignment = xlRight
      End Select

   Next 処理行
End Sub



Private Sub 処理指定とデータの読み込み()
   Dim キー列名 As String
   Dim 指定セル As Range

   ThisWorkbook.Worksheets("Sheet1").Activate

   コピー元ブック名 = Range("B7").Value
   コピー元シート名 = Range("B8").Value
   コピー元データ開始行 = Range("B9").Value
   コピー対象列 = Range("B11").Value

   貼付け先ブック名 = Range("C7").Value
   貼付け先シート名 = Range("C8").Value
   貼付け先データ開始行 = Range("C9").Value
   貼付け対象列 = Range("C11").Value

   If 貼付け先ブック名 = "" Then
      貼付け先ブック名 = コピー元ブック名
   End If

   If 貼付け先シート名 = "" Then
      貼付け先シート名 = コピー元シート名
   End If

   If 貼付け先データ開始行 = 0 Then
      貼付け先データ開始行 = コピー元データ開始行
   End If

   If 貼付け対象列 = "" Then
      貼付け対象列 = コピー対象列
   End If

   Set コピー元シート = Workbooks(コピー元ブック名).Worksheets(コピー元シート名)
   Set 貼付け先シート = Workbooks(貼付け先ブック名).Worksheets(貼付け先シート名)

   トリム処理 = Range("D11").Value
   型変換 = Range("E11").Value
   配置 = Range("G11").Value

   コピー元シート.Activate

   'コピー元シートから、対象データを配列に読み込む
   最終行 = Cells(ActiveSheet.Rows.Count, 列番号(コピー対象列)).End(xlUp).Row
   コピー対象行数 = 最終行 - コピー元データ開始行 + 1

   データ配列 = Range("A1").Cells(コピー元データ開始行, 列番号(コピー対象列)) _
      .Resize(コピー対象行数, 1).Value

   Set コピー元シート = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る

ホームページのトップに戻る