Board logo

標題: 請求高手...有方法能快速作嗎? [打印本頁]
作者: 卡嘉塔    時間: 2014-2-22 14:45     標題: 請求高手...有方法能快速作嗎?

本帖最後由 卡嘉塔 於 2014-2-22 14:48 編輯

A列 是主體  不能刪除的
然後 地點跟電話 欄位空白的話
則在B C 抓取資料 (重複名稱的)
B 為優先 其次是C
(A B C那一欄 不能砍! 就是最左邊的那個)
(沒有BC列的話 就直接保留原位置)

請問有方法快速作嗎? ...因為有數萬筆資料...作到有點快哭了....:'(


[attach]17572[/attach]
作者: c_c_lai    時間: 2014-2-22 14:58

回復 1# 卡嘉塔
不好意思！
實在看不懂妳的描述，可否舉例說明？
作者: yen956    時間: 2014-2-22 18:46

你的意思是要把重覆的 "名稱" 列刪除嗎?
重覆的 "名稱" 最左邊的 "A", "B", "C", 只保留一列?
且刪除列以前, 儘量保留 "地點", "電話" ?
(且 "A" 的重要性 > "B" 的重要性 > "C" 的重要性 >)
作者: yen956    時間: 2014-2-22 19:23

回復 1# 卡嘉塔
如果需求如3樓所說.
則：
先將資料表按升冪排序, 主要鍵→名稱(B欄), 次要鍵→類別(A欄)
  1. Private Sub CommandButton1_Click()
  2.     Dim i As Integer
  3.     Dim strB, strC As Range
  4.     For i = [B2].End(xlDown).Row To 2 Step -1
  5.        Set strB = Cells(i - 1, 2)
  6.        Set strC = Cells(i, 2)
  7.        If strC.Value = strB.Value Then
  8.            If strB.Offset(0, 1) = "" And strC.Offset(0, 1) <> "" Then
  9.                 strB.Offset(0, 1) = strC.Offset(0, 1)
  10.            End If
  11.            If strB.Offset(0, 2).Value = "" And strC.Offset(0, 2).Value <> "" Then
  12.                 strB.Offset(0, 2).Value = strC.Offset(0, 2).Value
  13.            End If
  14.            strC.EntireRow.Delete
  15.        End If
  16.     Next
  17. End Sub
複製代碼
結果如下圖
作者: 卡嘉塔    時間: 2014-2-22 19:51

[attach]17573[/attach]
對!!沒錯!!真的很感謝你!

對不起 還忘記加了另一個
b c 分類 假如沒有a的話 只有b和c的話 不用del 保留下來
好像有點複雜 頭好暈 = =
作者: 卡嘉塔    時間: 2014-2-22 19:59

那個對不起 我的超過3分鐘不能編輯訊息
我想請教一下 那一個刪除重複列
是這個嘛 因為找不到 0.0
[attach]17575[/attach]
作者: 卡嘉塔    時間: 2014-2-22 21:44

那個抱歉
請問那是 ? 要怎麼用?

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim strB, strC As Range
    For i = [B2].End(xlDown).Row To 2 Step -1
       Set strB = Cells(i - 1, 2)
       Set strC = Cells(i, 2)
       If strC.Value = strB.Value Then
           If strB.Offset(0, 1) = "" And strC.Offset(0, 1) <> "" Then
                strB.Offset(0, 1) = strC.Offset(0, 1)
           End If
           If strB.Offset(0, 2).Value = "" And strC.Offset(0, 2).Value <> "" Then
                strB.Offset(0, 2).Value = strC.Offset(0, 2).Value
           End If
           strC.EntireRow.Delete
       End If
    Next
End Sub
作者: yen956    時間: 2014-2-23 10:31

本帖最後由 yen956 於 2014-2-23 10:32 編輯

回復 7# 卡嘉塔
1. 回6f, 抱歉, 我的是 2003, 不清楚那個按鈕的作用!
2. 回7f, 那是VBA, 配合 CommandButton1 用的,
3. 建議下次 pos 圖時, 連【欄名】及【列號】一起  pos 出來,
大家比較容易看得懂.
附上檔案(已把【序號】列入了), 請參考看看.

刪除重覆列.7z
http://www.mediafire.com/download/whhfyklg45t6yu1/%E5%88%AA%E9%99%A4%E9%87%8D%E8%A6%86%E5%88%97.7z
作者: 卡嘉塔    時間: 2014-2-23 16:32

真的很感謝你
不過......想在問一下
假如需要填的資料不只兩筆 而是五六筆的話 要怎麼更改?
比如說這個
[attach]17578[/attach]
作者: yen956    時間: 2014-2-24 13:02

本帖最後由 yen956 於 2014-2-24 13:12 編輯

回復 9# 卡嘉塔
將8F 的 刪除重覆列.7z 抓下來,
打開 VBA 再修改.
  1. Private Sub CommandButton1_Click()
  2.     Dim i As Integer
  3.     Dim strB, strC As Range
  4.     '
  5.     '先將資料表按升冪排序, 主要鍵→名稱(C欄), 次要鍵→類別(A欄)； Range("A1:E21")是排序範圍
  6.     [A1].Resize([A1].End(xlDown).Row, [A1].End(xlToRight).Column).Sort _
  7.               Key1:=Range("C2"), Order1:=xlAscending, _
  8.               Key2:=Range("A2"), Order2:=xlAscending, _
  9.               Header:=xlYes
  10.                   
  11.     For i = [C2].End(xlDown).Row To 2 Step -1
  12.        Set strB = Cells(i - 1, 3)
  13.        Set strC = Cells(i, 3)
  14.        If strC.Value = strB.Value Then
  15.       
  16.            '保留D欄資
  17.            If strB.Offset(0, 1) = "" And strC.Offset(0, 1) <> "" Then
  18.                 strB.Offset(0, 1) = strC.Offset(0, 1)
  19.            End If
  20.            
  21.            '保留E欄資
  22.            If strB.Offset(0, 2).Value = "" And strC.Offset(0, 2).Value <> "" Then
  23.                 strB.Offset(0, 2).Value = strC.Offset(0, 2).Value
  24.            End If
  25.            '
  26.            '複製上列VBA, 再修再參數即可
  27.            '
  28.            strC.EntireRow.Delete
  29.        End If
  30.     Next
  31. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)