ID非公開

2022/5/22 23:03

44回答

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

画像
補足

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

Excel | Visual Basic84閲覧

ベストアンサー

0

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

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

お礼日時:5/23 22:35

その他の回答(3件)

0

なんか最近似たようなのものをやったんですが、 課題か何かなんですかね 同じ人じゃないですよね? https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12262140437 また質問文も整理したほうがいい。 ① >Sheet1(仮称)のA2:C2以降 「以降」だと、1で処理したその最終行も対象になりますよ? ② >画像と説明文が??? 1 Sheet1(仮称)のA2:C2から最終行まで入力された値を削除する。 とあるので、 4 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

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

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