請問：關於修改VBA語法

jsc0518

Dear 先進,

VBA語法如下，語法內有把"空白"都給刪除
我想把"若遇到A欄列空白時，不要刪除"，請問是要修正哪一段語法呢？

感謝各位！

Sub Step1()
'刪除 key word : 公司 / 單別: / 日期* / 產品大類: / 核准 / 合計* / 統計*
Dim reg As Object, a, rng As Range, z&
a = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).Value
z = UBound(a)
Set rng = Rows(z + 1)
Set reg = CreateObject("vbscript.regexp")
With reg
    .Pattern = "空白|公司|單別:|日期|產品大類:|核准|合計|總計"
    For i = 1 To z
        If Len(a(i, 1)) = 0 Or .test(a(i, 1)) Then
            Set rng = Union(rng, Rows(i))
        End If
    Next
End With
rng.Delete
Set rng = Nothing
End Sub

ikboy

try this:

1. Sub Step1()
   
2. '刪除 key word : 公司 / 單別: / 日期* / 產品大類: / 核准 / 合計* / 統計*
   
3. Dim reg As Object, a, rng As Range, z&
   
4. a = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).Value
   
5. z = UBound(a)
   
6. Set rng = Rows(z + 1)
   
7. Set reg = CreateObject("vbscript.regexp")
   
8. With reg
   
9.     .Pattern = "空白|公司|單別:|日期|產品大類:|核准|合計|總計"
   
10.     For i = 1 To z
    
11.         If .test(a(i, 1)) Then
    
12.             Set rng = Union(rng, Rows(i))
    
13.         End If
    
14.     Next
    
15. End With
    
16. rng.Delete
    
17. Set rng = Nothing
    
18. End Sub

複製代碼

jsc0518

回復 2# ikboy
Dear 謝謝您的回覆,
下列語法是將A欄列若有出現關鍵字時，就刪除該列
但我想把其中一個關鍵字"空白"-->若遇A欄列為空白時，就不要刪除
我改了
原本：    .Pattern = "空白|公司|單別:|日期|產品大類:|核准|合計|總計"
更改：    .Pattern = "公司|單別:|日期|產品大類:|核准|合計|總計"
但A欄列空白該列也會一併刪除
是否哪一段VBA語法需做修改呢？








Sub Step1()
'刪除 key word : 公司 / 單別: / 日期* / 產品大類: / 核准 / 合計* / 統計*
Dim reg As Object, a, rng As Range, z&
a = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).Value
z = UBound(a)
Set rng = Rows(z + 1)
Set reg = CreateObject("vbscript.regexp")
With reg
    .Pattern = "空白|公司|單別:|日期|產品大類:|核准|合計|總計"
    For i = 1 To z
        If Len(a(i, 1)) = 0 Or .test(a(i, 1)) Then
            Set rng = Union(rng, Rows(i))
        End If
    Next
End With
rng.Delete
Set rng = Nothing
End Sub

GBKEE

回復 3# jsc0518
刪除 key word : 公司 / 單別: / 日期* / 產品大類: / 核准 / 合計* / 統計*
.Pattern = "空白|公司|單別:|日期|產品大類:|核准|合計|總計"
沒有一致 有"空白" 當然會刪除

1. Option Explicit
   
2. Sub Step1()
   
3.     Dim key_word$, E As Range, Rng As Range
   
4.     key_word = "/公司/單別:/日期/產品大類:/核准/合計/統計/"
   
5.     For Each E In Range("a1:a" & Cells(Rows.Count, 1).End(3).Row)
   
6.         If InStr(key_word, "/" & E & "/") Then
   
7.             If Rng Is Nothing Then
   
8.                 Set Rng = E
   
9.             Else
   
10.                 Set Rng = Union(Rng, E)
    
11.             End If
    
12.         End If
    
13.     Next
    
14.     If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
15. 
    
16. End Sub

複製代碼

jsc0518

回復 4# GBKEE
感謝版主的回覆
TEST OK

我再把您分享的VBA語法改成
只要B欄列出現"領料"或是"領用"，就整欄列給予刪除
執行後，B欄列會刪除"領料"或是"領用"
但仍會有一些"領料"或是"領用"的B欄列仍存在，刪除不乾淨
是否哪裡需修訂？
感恩


Sub Step2()
'刪除關鍵字-B欄列--> 領料 領用
    Dim key_word$, E As Range, Rng As Range
    key_word = "/領用/領料/"
    For Each E In Range("b1:b" & Cells(Rows.Count, 1).End(3).Row)
        If InStr(key_word, "/" & E & "/") Then
            If Rng Is Nothing Then
                Set Rng = E
            Else
                Set Rng = Union(Rng, E)
            End If
        End If
    Next
    If Not Rng Is Nothing Then Rng.EntireRow.Delete

End Sub

jsc0518

回復 4# GBKEE
Dear 版主

附檔案 TT.rar (82.91 KB)

下載次數: 5

2018-2-3 17:14

執行step2，會有移除不乾淨的畫面

下載 (23.26 KB)

2018-2-3 17:15

最終的資料是希望
1.可以刪除不必要的欄列
2.另外在A欄下將有空白之欄位其日期自動與上一欄位一樣

下載 (152.77 KB)

2018-2-3 17:18

謝謝您

GBKEE

回復 6# jsc0518
Step2  應為 2 ->B欄 .1 為A欄
For Each E In Range("b1:b" & Cells(Rows.Count, 1).End(3).Row)
試試看

1. Option Explicit
   
2. Sub Step1()
   
3. '刪除關鍵字-A欄列
   
4. Dim key_word$, E As Range, Rng As Range
   
5. 'key_word = "/公司/單別:/日期:/日期/產品大類:/核准 覆核 單位主管 財會審核 製表人 /合計/合計:/統計/總計:/"
   
6. For Each E In ActiveSheet.UsedRange.Columns(1).Cells
   
7. If (Not IsDate(E) And E <> "") Or E.Cells(1, 2) <> "" Then
   
8. If Rng Is Nothing Then
   
9. Set Rng = E
   
10. Else
    
11. Set Rng = Union(Rng, E)
    
12. End If
    
13. End If
    
14. Next
    
15. If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
16. For Each E In Range("a1:a" & Cells(Rows.Count, 2).End(xlUp).Row)
    
17. If E(1, 3) <> "" And E = "" Then E = E.Cells(0)
    
18. Next
    
19. If [A1].End(xlDown).End(xlDown).Row <> Rows.Count Then
    
20. Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
21. End If
    
22. End Sub

複製代碼

jsc0518

回復 7# GBKEE
Deae 版主,
TEST OK，您真的好神歐
真的很感謝您的幫忙！

jsc0518

回復 7# GBKEE
Dear 版主
我用您教導VBA去執行，與我自己用手動刪除後之結果數據有差異

VBA執行後加總J欄位庫存數據

下載 (4 KB)

2018-2-4 10:26

   
手動刪除欄列，加總J欄位庫存數據

下載 (4.22 KB)

2018-2-4 10:26

附檔案
TT.rar (144.61 KB)

下載次數: 3

2018-2-4 10:28

請幫忙看一下！感恩！

GBKEE

回復 9# jsc0518
你的表格有第一筆資料開始A欄沒有日期所致
試試看

1. Option Explicit
   
2. Sub Step1()
   
3.     Dim E As Range, Rng As Range
   
4.     For Each E In ActiveSheet.UsedRange.Columns("A:C").Rows
   
5.        If (Not IsDate(E.Cells(1)) And E.Cells(1) <> "") Or E.Cells(2) <> "" Or Application.CountA(E.Cells) = 0 Then
   
6.             If Rng Is Nothing Then
   
7.                 Set Rng = E
   
8.             Else
   
9.                 Set Rng = Union(Rng, E)
   
10.             End If
    
11.         End If
    
12.     Next
    
13.     If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
14.     For Each E In Range("a1:a" & Cells(Rows.Count, 2).End(xlUp).Row)
    
15.         If E(1, 3) <> "" And E = "" Then E = E.Cells(0)
    
16.     Next
    
17. End Sub

複製代碼