【ノーコード】1分でExcelを自動化する無料ツール

コードの知識不要😊ChatGPTしようぜ⚾17

MENU

【ノーコードVBA】飛び飛びのセルの値をコピーし、リストにする

エクセルVBAマクロを自動作成する無料アプリです。

例として、アプリで「複数シートの飛び飛びのセルの値を、1枚のシートにまとめる」VBAマクロを作成します。

(ページの末尾に、VBAコード掲載)

事例 3枚のシートの、離れたセルのデータを1枚のシートにまとめます

マクロを実行すると、離れたセルの値がリスト化されました。

※1枚のシートの飛び飛びの値のリスト化も可能です。

 

アプリの設定

アプリのトップページ

 ⇒▼コピー・切り取り・貼り付け

 ⇒【ツール】飛び飛びのセルの値をコピーし、リストにする



【ポイント】

■ 見出しの左セルと、データの左上セルが、重ならないように注意してください。

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

 

VBAコードを見る

Sub デモ() '複数シートの、特定セルの値を、1枚のシートにまとめる
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
'◆見出しを入れる
Dim 見出し As Variant
見出し = Split("年月日,店舗,商品,単価,数量,金額", ",")
Sheets("まとめ").Select
Range("a1").Resize(1, UBound(見出し) + 1) = 見出し
'見出しを太字に
Range("a1").Resize(1, UBound(見出し) + 1).Font.Bold = True
'見出しを中央揃えに
Range("a1").Resize(1, UBound(見出し) + 1).HorizontalAlignment = xlCenter
'見出しの背景色をグレー
Range("a1").Resize(1, UBound(見出し) + 1).Interior.Color = RGB(231, 230, 230)
'◆シートごとに処理をする
Dim シート As Worksheet, アドレス As Variant, 配列2次元(), 行 As Long
Dim 除外辞書 As Object, 対象辞書 As Object, 配列 As Variant
Dim 除外配列 As Variant, 対象配列 As Variant, 数 As Long
Set 除外辞書 = CreateObject("Scripting.Dictionary")
Set 対象辞書 = CreateObject("Scripting.Dictionary")
'除外配列に、除外対象を代入
配列 = Split("まとめ", ",")
除外配列 = 配列
For 数 = 0 To UBound(除外配列)
   除外辞書.Add 除外配列(数), "除外"
Next 数
'シート名が除外辞書になければ、対象辞書に加える
For Each シート In Worksheets
   If Not 除外辞書.Exists(シート.Name) Then
       対象辞書.Add シート.Name, "対象"
   End If
Next シート
'対象のキーを、配列に入れる
対象配列 = 対象辞書.keys
'配列に入れた対象に、順次処理をする
For Each シート In Worksheets(対象配列)
'◆対象セルの値で、リストを作る
    Dim 列 As Long, セル As Variant
    行 = 行 + 1
    アドレス = Split("b1,b2,b3,d1,d2,d3", ",")
    '2次元側に「行」をいれて、要素数を変更
    ReDim Preserve 配列2次元(1 To UBound(アドレス) + 1, 1 To 行)
    For Each セル In アドレス
            列 = 列 + 1
            配列2次元(列, 行) = シート.Range(セル).Value
    Next セル
    列 = 0
Next
 
'◆2次元の行列を入れ替えて、貼り付け
Sheets("まとめ").Range("a2").Resize(行, UBound(アドレス) + 1) = Application.Transpose(配列2次元)
'罫線を入れる
Sheets("まとめ").Range("a2").CurrentRegion.Borders.LineStyle = True
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub
   

 

ChatGPTで修正

あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!

アプリはこちらから↓↓↓↓