返回列表 上一主題 發帖

請求高手...有方法能快速作嗎?

請求高手...有方法能快速作嗎?

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

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

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


ZXC.png

回復 1# 卡嘉塔
不好意思!
實在看不懂妳的描述,可否舉例說明?

TOP

你的意思是要把重覆的 "名稱" 列刪除嗎?
重覆的 "名稱" 最左邊的 "A", "B", "C", 只保留一列?
且刪除列以前, 儘量保留 "地點", "電話" ?
(且 "A" 的重要性 > "B" 的重要性 > "C" 的重要性 >)

TOP

回復 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
複製代碼
結果如下圖

TOP


對!!沒錯!!真的很感謝你!

對不起 還忘記加了另一個
b c 分類 假如沒有a的話 只有b和c的話 不用del 保留下來
好像有點複雜 頭好暈 = =

zxczxczxc.png (20.17 KB)

zxczxczxc.png

TOP

那個對不起 我的超過3分鐘不能編輯訊息
我想請教一下 那一個刪除重複列
是這個嘛 因為找不到 0.0

TOP

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

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

TOP

本帖最後由 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

TOP

真的很感謝你
不過......想在問一下
假如需要填的資料不只兩筆 而是五六筆的話 要怎麼更改?
比如說這個

TOP

本帖最後由 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
複製代碼

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題