初心者で教えて頂きながら、ここまできましたが、困ってしまいました。すみません。
この統合のマクロのシートに01~40のシートがあるとした場合。しかし、これ以外にも他にシートもある場合にシート名の文言にの前にこの01~40数字のあるものだけを統合することは可能だとわかったような気がします。下記の判定により、しかし、それをどのように生かすか試行錯誤しますがうまくいきませんので、どのように変えればよいのかを教えて頂けませんか。よろしくお願いします。
なお、この01~40は、現在01~05まででこれから増えていくことになります。「Sub 統合()」については、不要なシート以外の私がほしいデーターはとれていますが、私としては必要とする以外のデーターまでついて来てしまうので、どうにかならないかと思う次第です。
Sub 統合()
Dim I As Long
Dim r As Long
Dim s As Long
Dim Sh As Worksheet
Dim MaxRow As Long
Dim MaxCol As Long
Dim MyArray As Variant
Dim JoinSh As Worksheet
Set JoinSh = Worksheets("統合") '統合シートを変数に格納
JoinSh.Cells.Delete 'すでに統合シートが存在する場合は一旦セルを削除
s = 1 '最大行を超えた場合次の統合シートを作成するための番号
For I = s + 1 To Worksheets.Count 'シートを統合シートの次~末尾までループ
With Worksheets(I) '各月シート
If I = 1 Then
r = 1 '最初だけ項目も取得
Else
r = 3 '最初以外は2行目から取得
End If
MaxRow = .Cells(Rows.Count, 10).End(xlUp).Row '10列目で最終行を取得
MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得
MyArray = Range(.Cells(r, 10), .Cells(MaxRow, MaxCol)) 'A1~データ末尾まで配列に格納
End With
With JoinSh '統合シート
MaxRow = .Cells(Rows.Count, 10).End(xlUp).Row '統合シートの10列目で最終行取得
If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理
s = s + 1 '統合シートの番号を加算
Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加
ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加
Set JoinSh = ActiveSheet '統合シートを変数に格納
MaxRow = JoinSh.Cells(Rows.Count, 10).End(xlUp).Row '統合シートの10列目で最終行取得
End If
If .Cells(1, 1) = "" Then
'最初だけ1行目から貼り付け
Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray
Else
'最初以外は最終行の次に貼り付け
Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray
End If
End With
Next I
End Sub
更に、
シート名の文言にの前にこの01~40数字のあるものだけ、例えば以下のように判定すればよいとおもいます。というアドバイスを貰ってやってみました。判定はできましたが、今後どのように進めればよいか正直わからない状態です。
Sub 研究用()
Dim SH As Worksheet
Dim buf As String
For Each SH In Worksheets
buf = Left(SH.Name, 2)
If IsNumeric(buf) Then
Select Case buf * 1
Case 1 To 40
MsgBox SH.Name & " は対象シートです"
Case Else
MsgBox SH.Name & " は対象シートではありません"
End Select
Else
MsgBox SH.Name & " は対象シートではありません"
End If
Next SH
End Sub
No.1ベストアンサー
- 回答日時:
こんばんは
>判定はできましたが、今後どのように進めればよいか正直わからない状態です。
判定ができているのなら、表示する代わりにそのシートに対して目的の処理を行えばよいのではないでしょうか?
具体的には、MsgBoxを出す代わりに、実際の処理の記述を行えばよいです。
直接記述すると、全体構成がわかりにくくなってしまうようであるなら、元の処理を「シートを受け取ってそのシートに対して処理する」サブルーチンにしておいて、そちらを呼び出すようにするとか。
Case 1 To 40
MsgBox SH.Name & " は対象シートです"
↓ ↓ ↓
Case 1 To 40
Call 作成したサブルーチン(SH)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】特定のワードが入っている行全体を塗りつぶしたい 4 2022/04/20 15:22
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) コード名シートA列と集計シートA列のコードが一致したら、コード名シートA5からk12の範囲をコピーし 1 2022/08/29 23:46
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたい 6 2023/01/23 12:00
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) フォルダの場所を可変にしたいです(マクロ) 4 2023/05/11 10:00
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
原付 レッツシート開け方
-
括弧があるとHYPERLINKで飛べな...
-
ポップコーンの捨て方
-
車のシートがへたってきました...
-
シートベルトの固定解除
-
フォルツァ バッテリーを外して...
-
リアシート無しで運転してたら...
-
建築模型、カーブの作り方
-
水の染み込んだバイクのシート...
-
エクセルで複数のシートをフォ...
-
IHクッキングヒーターの操作パ...
-
車内ビショビショ・・・
-
バイクのシートを取り替えても...
-
粘土板に付かないようにするには
-
NCロードスター シート交換
-
車のシートを焦がしてしまった...
-
癒着してしまったテレビの液晶...
-
ドライブレコーダーのSDカード...
-
BRIDEのシート張り替えってでき...
-
シートのしわ
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで複数のシートをフォ...
-
括弧があるとHYPERLINKで飛べな...
-
建築模型、カーブの作り方
-
原付 レッツシート開け方
-
エクセルVBA 4行飛ばしで転記す...
-
Excel複数シートから日付と文字...
-
Excel VBA シート名変更時、重...
-
フォルツァ バッテリーを外して...
-
水の染み込んだバイクのシート...
-
BRIDEのシート張り替えってでき...
-
車のシートでおもらし
-
ノートe12ガソリン
-
リアシート無しで運転してたら...
-
ポップコーンの捨て方
-
車のシートがへたってきました...
-
シートベルトの固定解除
-
バイクのシートを取り替えても...
-
台車の下に敷くシートについて
-
マグネットシートって・・・
-
IHクッキングヒーターの操作パ...
おすすめ情報