123
返回列表 上一主題 發帖

列的複製／刪除與匯入

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 
29#
發表於 2010-12-14 14:32 | 只看該作者
回復 28# GBKEE


    大大~ 您說的是~ 很對不起~ 沒有好好研究你提供的方式~

    下次會改進~

     也是大大再一次提省了我~ 我終於有仔細看了大大寫的~ 了解大大程式碼的意思~

     謝謝大大~

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
28#
發表於 2010-12-14 12:31 | 只看該作者
本帖最後由 GBKEE 於 2010-12-14 12:32 編輯

回復 27# hugh0620
ActiveSheet.[a1] 有 1 或 2 才會執行   
給你的程式碼要研究一下才會進步
''''''''''''''''''''''  請自行 修改判斷式
If ActiveSheet.[a1] = 1 Then              '條件一  F欄等於X  且 CL且等於1    ->  '請在  [a1] 輸入  1
    .AutoFilter 6, "=X"
ElseIf ActiveSheet.[a1] = 2 Then       '條件二  O攔等於0 且 CL等於1就要 2  ->  '請在  [a1] 輸入  2   
   .AutoFilter 15, "=0"
End If
If ActiveSheet.[a1] = 1 Or ActiveSheet.[a1] = 2 Then   '''''''  請自行 修改判斷式      .
           . AutoFilter 90, "=1"
          .CurrentRegion.Offset(1).EntireRow.Delete
  End If

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
27#
發表於 2010-12-14 11:26 | 只看該作者
本帖最後由 hugh0620 於 2010-12-14 11:28 編輯

回復 25# GBKEE

     大大請看~

     執行後還是無動靜~

    兩個條件下分別刪除列.zip (19.66 KB)

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

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


    親愛滴大大~ 一樣還是沒有任何刪除的動作耶~ :dizzy:

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
25#
發表於 2010-12-10 15:58 | 只看該作者
回復 24# hugh0620
忘記 顯示顯示全部資料
  1.   Sub Ex()
  2.     With ActiveSheet
  3.         If .AutoFilter Is Nothing Then
  4.             .Rows(6).AutoFilter
  5.         Else
  6.             .Cells.AutoFilter
  7.             .Rows(6).AutoFilter
  8.         End If
  9.         With .Rows(6)
  10.             ''''''''''''''''''''''  請自行 修改判斷式
  11.             If ActiveSheet.[a1] = 1 Then              '條件一  F欄等於X  且 CL且等於1
  12.                 .AutoFilter 6, "=X"
  13.             ElseIf ActiveSheet.[a1] = 2 Then       '條件二  O攔等於0 且 CL等於1就要
  14.                 .AutoFilter 15, "=0"
  15.             End If
  16.             If ActiveSheet.[a1] = 1 Or ActiveSheet.[a1] = 2 Then   '''''''  請自行 修改判斷式
  17.                 .AutoFilter 90, "=1"
  18.                 .CurrentRegion.Offset(1).EntireRow.Delete
  19.             End If
  20.         '''''''''''''''''''''''''''''''''''''''
  21.         End With
  22.          .Cells.AutoFilter    '取消自動篩選 顯示顯示全部資料
  23.    End With
  24. End Sub
複製代碼

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

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


    大大~ 執行結果~ 沒有任何刪除的動作~ 只有將篩選的資料全部解開~
             請大大示下~

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

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


      謝謝大大幫忙解決問題~ 我會測試一下~ 若有問題再請教大大

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
22#
發表於 2010-12-10 12:15 | 只看該作者
回復 21# hugh0620
  1. Sub Ex()
  2.     With ActiveSheet
  3.         If .AutoFilter Is Nothing Then
  4.             .Rows(6).AutoFilter
  5.         Else
  6.             .Cells.AutoFilter
  7.             .Rows(6).AutoFilter
  8.         End If
  9.         With .Rows(6)
  10.             ''''''''''''''''''''''  請自行 修改判斷式
  11.             If ActiveSheet.[a1] = 1 Then              '條件一  F欄等於X  且 CL且等於1
  12.                 .AutoFilter 6, "=X"
  13.             ElseIf ActiveSheet.[a1] = 2 Then       '條件二  O攔等於0 且 CL等於1就要
  14.                 .AutoFilter 15, "=0"
  15.             End If
  16.             If ActiveSheet.[a1] = 1 Or ActiveSheet.[a1] = 2 Then   '''''''  請自行 修改判斷式
  17.                 .AutoFilter 90, "=1"
  18.                 .CurrentRegion.Offset(1).EntireRow.Delete
  19.             End If
  20.         '''''''''''''''''''''''''''''''''''''''
  21.         End With
  22.     End With
  23. End Sub
複製代碼

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

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

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

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

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





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

TOP

        靜思自在 : 君子為目標，小人為目的。
123
返回列表 上一主題