12
返回列表 上一主題 發帖

列的複製／刪除與匯入

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2010-11-26 11:43 | 顯示全部帖子

列的複製／刪除與匯入

Dear 大大們

     小弟遇到列的複雜/刪除與匯入上的問題
     詳述如下:
        我需要將
     1. Sheet1中有疑問的資料轉到sheet2中
     2. 將Sheet1中有疑問的資料刪除  (因Sheet2的資料澄清後,需要在匯回Sheet1中,會避免資料重覆的情況下,需要先行刪除)
       3.Sheet2的資料澄清後,需要在匯回Sheet1中  (還沒有寫)
     我在VBA寫法
    1.將Sheet1中有疑問的資料轉到sheet2中
     x = 0
       K = 0
       Do Until Sheet1.Cells(7 + x, 12) = ""
          If Sheet1.Cells(7 + x, 6) <> "" Then
             Sheet1.Rows(7 + x).Copy
             Sheet2.Select
             Sheet2.Rows(7 + k).Select
              ActiveSheet.Paste
              k = k + 1
           End If
        2. 將Sheet1中有疑問的資料刪除
      x = 0
         Do Until Sheet1.Cells(7 + x, 12) = ""
             For J = 0 To x
                If Sheet1.Cells(7 + J, 6) <> "" Then
                     Sheet1.Rows(7 + J).Delete
                End If
           Next J
             x = x + 1
          Loop
        可是這樣的寫法在執行上比較慢,請問大大是否有較好的方法
      另外第3.將資料匯回sheet1也有點卡住,盼能夠有提點一下
      這是我的寫法,不過我要貼的是從空白的地方接資料,但是執行後,檢查資料,卻沒有成功
      x = 0
         k = 0
         Do Until Sheet2.Cells(7 + x, 6) = ""
              If Sheet1.Cells(7 + k, 12) = "" Then
                 Sheet2.Rows(7 + x).Copy
                 Sheet1.Select
                 Sheet1.Rows(7 + k).Select
                 ActiveSheet.Paste
                  x = x + 1
               End If
               k = k + 1
         Loop
收藏 分享

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
2#
發表於 2010-11-26 12:58 | 顯示全部帖子
[版主管理留言]
  • Hsieh(2010-11-27 00:23): 檔名勿使用特殊符號

本帖最後由 hugh0620 於 2010-11-26 13:02 編輯

回復 2# Hsieh 列的複製&刪除與匯入.rar (55.79 KB)

[ 大大 已經將附件放上sheet1中的F欄位就是資料有誤需要澄清的部份

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
3#
發表於 2010-11-26 18:40 | 顯示全部帖子
回復 4# GBKEE


    有測試過可以打開~
    是打不開還是無法下載呢????

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
4#
發表於 2010-11-29 09:49 | 顯示全部帖子
回復 7# oobird


    版主~..  謝謝您的回覆唷~ 不過小地在測試時,有點小小的問題存在~
                因如果使用者不小心再點到一次的話~ 該程式碼就會產生執行的錯誤....

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
5#
發表於 2010-11-29 11:10 | 顯示全部帖子
回復 8# GBKEE


    大大是高手,在測試上是ok的~ 只不過小弟無法吸收大大的功力~  (看不太懂)
    無法將大大的方式應用在後續實務上~   不過還是要感謝大大

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
6#
發表於 2010-11-30 14:55 | 顯示全部帖子
回復 12# Hsieh

版主~ 我有將你的寫法改成我實際要用的方式,因我在執行時,有三個條件要先匯出,這方面的執行速度上ok~ 很快~
          但在刪除上,若是用版主的方法,每刪除一筆資料會重新計算儲存格導致執行時變很慢
       我將刪除的部份修改成下列的方式,可執行,但很慢                            (我的資料量約5000列*89欄的資料需要處理)

    Private Sub CommandButton1_Click()  '刪除
        With Sheet1
            r = .[L65536].End(xlUp).Row
               Do Until r < 7
                  If .Cells(r, 6) <> "" or Cells(r, 15) = 0 or Cells(r, 89) = 0  Then
                    .Rows(r).Delete xlShiftUp '刪除
                    End If
                          r = r - 1
              Loop
      End With
End Sub

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
7#
發表於 2010-12-1 12:07 | 顯示全部帖子
回復 14# oobird


    版主大大~ 小弟有試過將自動儲存格先行關閉,再打開

  在原程式碼前加上 application.calculation = xlcalculationManual

   在原程式碼前後上 application.calculation = xlcalculationAutomatic

  執行的結果,從原本的快20分鐘左右 減 至 7分鐘

是有加外很多~  還能夠在處理上加快嘛???

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
8#
發表於 2010-12-1 15:02 | 顯示全部帖子
回復 8# GBKEE


    謝謝大大~ 雖然還是不太懂你寫的方法~ 但小弟終於測試到最後~ 可以應用在我需要的工作上~
    使我處理速度上快很多~ 感恩~

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
9#
發表於 2010-12-9 18:33 | 顯示全部帖子
本帖最後由 hugh0620 於 2010-12-9 18:36 編輯

回復 8# GBKEE


    大大~ 想再請問你一個問題~
            大大原程式的寫法~ 是針對一個條件下去刪除~
            若小弟需要同一列上要符合兩個條件下才做刪除的動作~
            該如何修改程式碼呢????


Private Sub CommandButton1_Click()  '匯出與刪除
    With Sheet1.Range("f6").CurrentRegion.Columns(6).Offset(2)      <--- 若我的條件是F欄與K欄資料符合我刪除的條件,才進行刪除的動作
        On Error Resume Next
        With .SpecialCells(2).EntireRow
                .Copy Sheet2.Range("A" & Sheet2.Range("F" & Rows.Count).End(xlUp).Row).Offset(1)
                .Delete
        End With
    End With
End Sub

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
10#
發表於 2010-12-10 09:28 | 顯示全部帖子
回復 20# GBKEE

         大大~ 我把需求做出一個例子~ 供大大了解我的問題

      附檔內 資料範圍 A~CL欄
          條件一  F欄等於X  且 CL等於1 就要刪掉
          條件二  O攔等於0 且 CL等於1 就要刪除
          上述兩個條件是會依需求分別執行,不是一次就執行

            (當我執行完後需要使用條件一時, 僅會執行條件一,而條件二不會執行)





                                 兩個條件下分別刪除列.rar (12.21 KB)

TOP

        靜思自在 : 人事的艱難與琢磨，就是一種考驗。
12
返回列表 上一主題