帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2018-2-2 14:54 | 只看該作者

請問：關於修改VBA語法

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

樓主熱帖

Just do it.

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

26^#

發表於 2018-2-12 18:00 | 只看該作者

回復 25# jsc0518
一個程式碼並不能通用於所有類似的狀況
附檔中因A欄沒有使用到 ,不適用 ActiveSheet.UsedRange.Columns("B") 為 ActiveSheet的 C 欄
要看你實際上檔案需有所修改,請再附檔看看

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

25^#

發表於 2018-2-12 16:39 | 只看該作者

回復 22# GBKEE
檔案如下

Book1.rar (11.12 KB)

Just do it.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

24^#

發表於 2018-2-12 14:19 | 只看該作者

[版主管理留言]

GBKEE(2018/2/12 16:24): 附檔看看

回復 22# GBKEE
Dear 版主,
我使用您的VBA做修改"空白欄位可以自動複製與上一筆資料相同"
我把VBA改成B欄時，卻無動作(空白欄位無法自動複製與上一筆資料相同)，是否哪一段語法未修訂？
Thanks!

Sub Step6()
'空白欄位可以自動複製與上一筆資料相同-B
With ActiveSheet.UsedRange.Columns("B")
      If .Cells(1).End(xlDown).End(xlDown).Row <> Rows.Count Then  '判斷有空白的儲存格  !!!!
         .SpecialCells(xlCellTypeBlanks).Cells = "=R[-1]C"                      '沒有空白的儲存格 .SpecialCells(xlCellTypeBlanks) 程式會錯誤
         .Value = .Value
      End If
End With
End Sub

Just do it.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

23^#

發表於 2018-2-12 12:55 | 只看該作者

回復 22# GBKEE
Dear 版主,
我再試試看您所提供的方法
感恩！

Just do it.

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

22^#

發表於 2018-2-12 11:23 | 只看該作者

回復 21# jsc0518
Sub Step1() , Sheets("vba") ,  Sheets("資料庫")
是在同一個 xlsm  嗎?
不是須指名 Workbooks("xxx").( Sheets("vba") ,  Workbooks("xxx"). Sheets("資料庫")

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

21^#

發表於 2018-2-12 09:59 | 只看該作者

回復 19# GBKEE
Dear 版主,
我運用了您所教導的語法，有發生下圖，請問要更改哪一語法呢？
謝謝您!

Option Explicit
Sub Step1()
Dim E As Range, Rng As Range
With Sheets("vba")  'With 陳述式在一個單一物件或一個使用者自訂型態上執行一系列的陳述式。
      '3********指定要複製的範圍*********************************
   Set Rng = .UsedRange 'Sheets("vba")上已使用的範圍為 "A:H"
End With
'4**************指定的範圍複製到指定位置 **********************
With Sheets("資料庫").Range("b" & Rows.Count).End(xlUp)
      If .Cells = "" Then '第一列
         Rng.Copy .Cells
      Else
         Rng.Copy .Offset(1)
      End If
End With
End Sub

Just do it.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

20^#

發表於 2018-2-8 17:08 | 只看該作者

回復 19# GBKEE
Dear 版主,
感謝回復，可以用了，感恩！

Just do it.

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

19^#

發表於 2018-2-8 14:55 | 只看該作者

回復 18# jsc0518
可改一下

With Sheets("資料庫").Range("b" & Rows.Count).End(xlUp)
If .Cells = "" Then '第一列
Rng.Copy .Cells
Else
Rng.Copy .Offset(1)
End If
End With

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 232
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

18^#

發表於 2018-2-8 13:29 | 只看該作者

回復 16# jsc0518
Dear 版主您好，
我將VBA濃縮成下列說明，想跟您請教一下
1.在工作表"資料庫"B欄~I攔下若有歷史資料時，VBA可以COPY過去
2.在工作表"資料庫"B欄~I攔下若無歷史資料時，會發生錯誤

檔案

TT.rar (78.22 KB)

VBA 語法

Option Explicit
Sub Step1()
Dim E As Range, Rng As Range
With Sheets("vba")  'With 陳述式在一個單一物件或一個使用者自訂型態上執行一系列的陳述式。
      '3********指定要複製的範圍*********************************
   Set Rng = .UsedRange 'Sheets("vba")上已使用的範圍為 "A:H"
End With
'4**************指定的範圍複製到指定位置 **********************
With Sheets("資料庫").Range("b1").End(xlDown).Offset(1)
      'Range.End 屬性傳回 Range 物件，該物件代表包含來源範圍之區域結尾處的儲存格。
      '等於按 END+向上鍵、END+向下鍵、END+向左鍵或 END+向右鍵

      'Range.Offset 屬性會傳回 Range 物件，代表從指定之範圍位移的範圍
      Rng.Copy .Cells
End With
End Sub

Just do it.

TOP