下記のVBAで
・a列の最終行までの重複しているその行全体を削除
・b列の最終行までの「NG」と「中断」がある行全体を削除
したいのですがうまくいきません。どこにどのようにしたらできるでしょうか?
a列のの重複だけ削除されていて他の行が残ったりします。
詳しい方教えて下さい。お願いします。
Sub 一覧()
Dim lastRow As Long
Dim sourceRange As Range
Dim destinationRange As Range
Dim firstUnderscorePos As Integer
Dim lastUnderscorePos As Integer
Dim valueBeforeUnderscore As String
Dim valueAfterUnderscore As String
' シート1で最終行を取得
lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row
' シート1でA2から最終行までの範囲を選択
Set sourceRange = Sheets("Sheet1").Range("A2:A" & lastRow)
' シート2のA1セルから貼り付け
Set destinationRange = Sheets("Sheet2").Range("A1")
' 最初の"_"部分までをA列に、最後の"_"部分のあとをB列に貼り付け
For Each cell In sourceRange
valueBeforeUnderscore = ""
valueAfterUnderscore = ""
' "_"の位置を取得
firstUnderscorePos = InStr(1, cell.value, "_")
lastUnderscorePos = InStrRev(cell.value, "_")
' "_"が存在する場合
If firstUnderscorePos > 0 And lastUnderscorePos > 0 Then
' "_"の前の部分を取得
valueBeforeUnderscore = Mid(cell.value, 1, firstUnderscorePos - 1)
' "_"の後の部分を取得
valueAfterUnderscore = Mid(cell.value, lastUnderscorePos + 1)
End If
' ".xlsx"を削除
valueBeforeUnderscore = Replace(valueBeforeUnderscore, ".xlsx", "")
valueAfterUnderscore = Replace(valueAfterUnderscore, ".xlsx", "")
' A列に貼り付け
destinationRange.value = valueBeforeUnderscore
' B列に貼り付け
destinationRange.Offset(0, 1).value = valueAfterUnderscore
' 次の行に移動
Set destinationRange = destinationRange.Offset(1, 0)
Next cell
End Sub
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
以下のマクロを登録してください。
Sub 一覧 実行後にこのマクロを実行してください。
Public Sub 行削除()
Dim ws As Worksheet
Dim lastRow As Long
Dim del_rows As Range
Dim dicT As Object
Dim ctr As Long: ctr = 0
Dim key As String
Dim dflag As Boolean
Dim rg As String
Dim wrow As Long
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set ws = Worksheets("Sheet2")
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For wrow = 1 To lastRow
dflag = False
If InStr(ws.Cells(wrow, 2).Value, "NG") > 0 Then dflag = True
If InStr(ws.Cells(wrow, 2).Value, "中断") > 0 Then dflag = True
If dflag = False Then
key = ws.Cells(wrow, 1).Value
If dicT.exists(key) = False Then
dicT(key) = True
Else
dflag = True
End If
End If
If dflag = True Then
rg = wrow & ":" & wrow
If ctr = 0 Then
Set del_rows = Range(rg)
Else
Set del_rows = Union(del_rows, Range(rg))
End If
ctr = ctr + 1
End If
Next
If ctr > 0 Then
del_rows.Delete
End If
MsgBox (ctr & "件削除完了")
End Sub
No.1
- 回答日時:
削除したいのは、Sheet2のデータでしょうか?
Sheet1には、具体的には、どのような内容のデータがあるのでしょうか。
削除したいのはSheet2のデータです。
Sheet1には0001_OKのような数字とOK、NGが一緒になった名前もものがA列に並んでいます。(0002_OK、0003_NG・・・)
Sheet2にSheet1の数字部分をA列にOK、NG部分をB列に分けて貼り付けています。Sheet2のA列で重複を探してその行を削除して、B列でNGを探してその行を削除したいです。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Sub 分けてソートして貼り付ける() Dim srcSheet As Worksheet Dim 6 2023/08/04 19:57
- Excel(エクセル) B列に文字がはいったらA列に数字が入るマクロードを完成させたい 4 2023/04/21 01:58
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) A2~I4179列にあるリストを支社名ごとにシートに分けたいです。 各シート名はA列にある支社名とし 3 2023/08/29 16:46
- Visual Basic(VBA) VBA listBoxについて 2 2024/03/26 16:14
- Excel(エクセル) VBA Private Sub Worksheet_Changeで 1 2024/05/01 16:59
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelで、あるセルの値に応じて...
-
Worksheets メソッドは失敗しま...
-
B列の最終行までA列をオート...
-
【VBA】2つのシートの値を比較...
-
Cellsのかっこの中はどっちが行...
-
VBAのFind関数で結合セルを検索...
-
VBA 何かしら文字が入っていたら
-
【Excel VBA】 B列に特定の文字...
-
vba 2つの条件が一致したら...
-
データグリッドビューの一番最...
-
エクセル 2つの表の並べ替え
-
文字列の結合を空白行まで実行
-
IIF関数の使い方
-
VBAでのリスト不一致抽出について
-
エクセルVBAで『A列』に新...
-
別シートのデータを参照して値...
-
エラーコード1004
-
難問 VBA 今日の日付より前に対...
-
【Excel VBA】カンマと改行コー...
-
VBAを使って検索したセルをコピ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Worksheets メソッドは失敗しま...
-
B列の最終行までA列をオート...
-
Cellsのかっこの中はどっちが行...
-
IIF関数の使い方
-
Changeイベントでの複数セルの...
-
【VBA】2つのシートの値を比較...
-
VBA 何かしら文字が入っていたら
-
URLのリンク切れをマクロを使っ...
-
VBAのFind関数で結合セルを検索...
-
DataGridViewに空白がある場合...
-
VBAを使って検索したセルをコピ...
-
文字列の結合を空白行まで実行
-
データグリッドビューの一番最...
-
VBAでのリスト不一致抽出について
-
エクセル 2つの表の並べ替え
-
rowsとcolsの意味
-
【Excel VBA】 B列に特定の文字...
-
VBA 列が空白なら別のマクロへ...
おすすめ情報

