ID非公開

2022/5/22 23:03

44回答

ExcelのVBAについて教えてください。 シートが３つあり、 「そのうち２つは入力された値を削除し、 １つは入力された値を別のシートに転記する」

ExcelのVBAについて教えてください。 シートが３つあり、 「そのうち２つは入力された値を削除し、 １つは入力された値を別のシートに転記する」 という処理をボタン１つで実行したいです。 手順としては次のとおりです。 １ Sheet1（仮称）のA2:C2から最終行まで入力された値を削除する。 ２ Sheet2（仮称）のB2の絞り込みを解除する。 ３ Sheet2（仮称）のA2:C2から最終行まで入力された値を削除する。 ４ Sheet3（仮称）のA2:C2から最終行まで入力された値を切り取り、 Sheet1（仮称）のA2:C2以降に貼り付ける。 図々しいお願いで申し訳ありませんが、 コピペして使用できるようにVBAを組んでいただけると嬉しいです。 ご協力よろしくお願いいたします！

画像
補足

質問文と画像中のシート名が異なっていたので補足します。 Sheet1の名称は、前月集計 Sheet2の名称は、今月集計 Sheet3の名称は、今月集計（一部抜粋） です。 ごちゃごちゃでごめんなさい…

Excel | Visual Basic・84閲覧

ベストアンサー

0
PSX

2022/5/23 7:20

Sub a() '一例です Dim rng(1 To 3) As Range '各シートのクリア領域を設定 Set rng(1) = Worksheets("Sheet1").AutoFilter.Range.Offset(1, 0) Set rng(2) = Worksheets("Sheet2").AutoFilter.Range.Offset(1, 0) Set rng(3) = Worksheets("Sheet3").AutoFilter.Range.Offset(1, 0) rng(1).ClearContents With rng(3) .Copy rng(1) .ClearContents End With With rng(2).Parent '絞り込みを調べて、絞り込まれていたら、絞り込み解除 If .FilterMode Then .ShowAllData End With rng(2).ClearContents End Sub

ThanksImg質問者からのお礼コメント

皆さんご回答ありがとうございました！ 早速、作成いただいたVBAで処理を実行したところ、 PSX様のものがより早く処理できたので、 ベストアンサーに選ばせていただきました！ とても助かりました♪♪

お礼日時：5/23 22:35

その他の回答（3件）

0
ささいさいさい

カテゴリマスター

2022/5/23 1:34

なんか最近似たようなのものをやったんですが、 課題か何かなんですかね 同じ人じゃないですよね？ https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12262140437 また質問文も整理したほうがいい。 ① >Sheet1（仮称）のA2:C2以降 「以降」だと、１で処理したその最終行も対象になりますよ？ ② >画像と説明文が？？？ １ Sheet1（仮称）のA2:C2から最終行まで入力された値を削除する。 とあるので、 ４ Sheet3（仮称）のA2:C2から最終行まで入力された値を切り取り、 Sheet1（仮称）のA2:C2以降に貼り付ける。 貼り付け位置は、1で削除した値より↓にはりつけるのでないの？ ③ >値を切り取り、 Sheet1（仮称）のA2:C2以降に貼り付ける いわゆるカット&ペーストみたいに書いています。 単に値だけの書き換えならカット&ペーストとは書かないほうがいいです。 VBAでの記載する場合、今回みたいに Sheet1列A～最終行 カット& Sheet3ペースト Sheet1列B～最終行 カット& Sheet3ペースト Sheet1列C～最終行 カット& Sheet3ペースト としなければならず、かなりコード量が増えて複雑になります。 一応、 ①以降とあるが、その1つ↓の行 ②1でクリアした1つの下の行に貼付 ③値のだけではなく、1行ずつカット&ペースト したコードです複雑すぎて長いです。 Sub 転記処理() Dim ws As Worksheet Dim startAddress As Variant, endAddress As Variant Dim memoryAddress1 As Variant, memoryAddress2 As Variant, memoryAddress3 As Variant Dim sheetNameList As Collection Set sheetNameList = New Collection sheetNameList.Add "前月集計" sheetNameList.Add "今月集計" sheetNameList.Add "今月集計（一部抜粋）" Dim currentSheetName As Variant Dim i As Long For i = 1 To 3 Dim j As Long For Each currentSheetName In sheetNameList j = j + 1 currentSheetName = sheetNameList.Item(j) If i = j Then Exit For End If Next Set ws = Worksheets(currentSheetName) ws.Select If i < 3 Then startAddress = "A2" endAddress = ws.Cells(Rows.Count, ws.Range(startAddress).Column).End(xlUp).address If i = 1 Then memoryAddress1 = endAddress End If ws.Range(startAddress & ":" & endAddress).Clear startAddress = "B2" endAddress = ws.Cells(Rows.Count, ws.Range(startAddress).Column).End(xlUp).address If i = 1 Then memoryAddress2 = endAddress End If ws.Range(startAddress & ":" & endAddress).Clear startAddress = "C2" endAddress = ws.Cells(Rows.Count, ws.Range(startAddress).Column).End(xlUp).address If i = 1 Then memoryAddress3 = endAddress End If ws.Range(startAddress & ":" & endAddress).Clear End If If i = 2 Then If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If End If If i = 3 Then Set ws = Nothing currentSheetName = sheetNameList.Item(i) Set ws = Worksheets(currentSheetName) ws.Select startAddress = "A2" endAddress = ws.Cells(Rows.Count, ws.Range(startAddress).Column).End(xlUp).address ws.Range(startAddress & ":" & endAddress).Cut currentSheetName = sheetNameList.Item(1) Dim ws2 As Worksheet Set ws2 = Worksheets(currentSheetName) ws2.Select startAddress = memoryAddress1 startAddress = ws2.Range(startAddress).Offset(1, 0).address ws2.Range(startAddress).Select ActiveSheet.Paste startAddress = "B2" endAddress = ws.Cells(Rows.Count, ws.Range(startAddress).Column).End(xlUp).address ws.Range(startAddress & ":" & endAddress).Cut startAddress = memoryAddress2 startAddress = ws2.Range(startAddress).Offset(1, 0).address ws2.Range(startAddress).Select ActiveSheet.Paste startAddress = "C2" endAddress = ws.Cells(Rows.Count, ws.Range(startAddress).Column).End(xlUp).address ws.Range(startAddress & ":" & endAddress).Cut startAddress = memoryAddress3 startAddress = ws2.Range(startAddress).Offset(1, 0).address ws2.Range(startAddress).Select ActiveSheet.Paste End If Next End Sub

0
tra********

カテゴリマスター

2022/5/23 0:12

Sub sample() Const cName As String = ",前月集計,今月集計,今月集計（一部抜粋）" Dim xAdr As String, xNames, i As Long xAdr = "A2:C" & Rows.Count xNames = Split(cName, ",") For i = 2 To 3 With Worksheets(i) If i = 2 Then .AutoFilterMode = False If i = 3 Then .Range(xAdr).Copy Worksheets(1).Range(xAdr) .Range(xAdr).Clear End With Next i End Sub

0
Masa********

2022/5/22 23:29

シート2とかシート3とか、前月集計とか、今月集計とか、今月集計（一部抜粋）とか、 なにがなんだか、意味がわかりません。 統一しで、再質問した方がいいと思います。