返回列表 上一主題 發帖

請問:關於修改VBA語法

回復 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. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 11# jsc0518
兩者都可以
  1. With ActiveSheet.UsedRange.Columns("A")
  2.         If .Cells(1).End(xlDown).End(xlDown).Row <> Rows.Count Then  '判斷有空白的儲存格
  3.             .SpecialCells(xlCellTypeBlanks).Cells = "=R[-1]C"                        '沒有空白的儲存格 .SpecialCells(xlCellTypeBlanks) 程式會錯誤
  4.             .Value = .Value
  5.         End If
  6.    End With
複製代碼
  1.     For Each E In ActiveSheet.UsedRange.Columns("A").Cells
  2.         If E(1, 3) <> "" And E = "" Then E = E.Cells(0)      
  3.       'E(1, 3) => E.Cells(1, 3) ,E.Cells(0)=> E.Cells(0, 1) ** 0 -> 上一列
  4.     Next
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2018-2-8 07:08 編輯

回復 14# jsc0518
  1. Option Explicit
  2. Sub Step1()
  3.     Dim E As Range, Rng As Range
  4.     With Sheets("vba")  'With 陳述式 在一個單一物件或一個使用者自訂型態上執行一系列的陳述式。
  5.         '1*****處理要刪除的列 的迴圈****************
  6.         For Each E In .UsedRange.Columns("A:C").Rows
  7.              'UsedRange 屬性會傳回 Range 物件,此物件代表指定工作表上的已用範圍
  8.             If (Not IsDate(E.Cells(1)) And E.Cells(1) <> "") Or E.Cells(2) <> "" Or Application.CountA(E.Cells) = 0 Then
  9.                 If Rng Is Nothing Then   'Nothing 關鍵字是用來將一個物件變數從一個實際的物件�堣擢鰶}來
  10.                    Set Rng = E   'Set(設定變數為物件)  要刪除的列(物件)指定到變數
  11.                 Else    'Not Nothing
  12.                     Set Rng = Union(Rng, E)  'Application.Union 方法 會傳回兩個以上範圍的聯集。
  13.                 End If
  14.             End If
  15.         Next
  16.         If Not Rng Is Nothing Then Rng.EntireRow.Delete   '
  17.             'Range.EntireRow 屬性會傳回 Range 物件,此物件代表包含指定範圍的整個列 (或若干列)。
  18.         '2***********A欄有空白填上日期   *******************************
  19.         For Each E In Range("a1:a" & Cells(Rows.Count, 2).End(xlUp).Row)
  20.             If E(1, 3) <> "" And E = "" Then E = E.Cells(0)
  21.         Next
  22.         '3********指定要複製的範圍*********************************
  23.        Set Rng = .UsedRange   'Sheets("vba")上已使用的範圍為 "A:H"
  24.     End With
  25.     '4**************指定的範圍複製到指定位置 **********************
  26.     With Sheets("資料庫").Range("b1").End(xlDown).Offset(1)
  27.         'Range.End 屬性 傳回 Range 物件,該物件代表包含來源範圍之區域結尾處的儲存格。
  28.         '等於按 END+向上鍵、END+向下鍵、END+向左鍵或 END+向右鍵
  29.    
  30.         'Range.Offset 屬性 會傳回 Range 物件,代表從指定之範圍位移的範圍
  31.         Rng.Copy .Cells
  32.     End With
  33. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 18# jsc0518
可改一下
  1. With Sheets("資料庫").Range("b" & Rows.Count).End(xlUp)
  2.         If .Cells = "" Then    '第一列
  3.             Rng.Copy .Cells
  4.         Else
  5.             Rng.Copy .Offset(1)
  6.         End If
  7.     End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 21# jsc0518
Sub Step1() , Sheets("vba") ,  Sheets("資料庫")
是在同一個 xlsm  嗎?
不是 須指名 Workbooks("xxx").( Sheets("vba") ,  Workbooks("xxx"). Sheets("資料庫")
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 25# jsc0518
一個程式碼並不能通用於所有類似的狀況
附檔中因A欄沒有使用到 ,不適用 ActiveSheet.UsedRange.Columns("B") 為 ActiveSheet的 C 欄
要看你實際上檔案需有所修改,請再附檔看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 要比誰更受誰.不要比誰更怕誰。
返回列表 上一主題