返回列表 上一主題 發帖

請高手幫忙囉

請高手幫忙囉

小弟要計算訂單曾經入款的筆數,
但是公司系統會因為變更付款方式後而產生二個項次,
所以,卡住了,不知道該用什麼方法解決!
請幫忙!

取消.rar (6.59 KB)

新人一枚

回復 1# eric093

以附件內容執行後結果應該如下,也就是說,這訂單號碼曾經付款過,入款過,我就要刪除,只留下不曾入款過的

訂單號碼        項次        付款狀況
12345        1        取消
新人一枚

TOP

本帖最後由 GBKEE 於 2014-8-12 06:56 編輯

回復 2# eric093
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, d As Object, i As Variant, A As String
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Set Rng =工作表1.Range("a1").CurrentRegion
  6.     For i = 2 To Rng.Rows.Count
  7.         A = Rng(i, 1) & "-" & Rng(i, 2)
  8.         If d.EXISTS(A) Then   '字典物件的(key值)存在傳回True
  9.             Set d(A) = Union(Rng.Rows(i), d(A))
  10.         Else
  11.             Set d(A) = Rng.Rows(i)
  12.         End If
  13.     Next
  14.     For Each i In d.KEYS
  15.         If d(i).Rows.Count = 1 And InStr(d(i).Cells(3), "取消") = 0 Then
  16.             d(i).Delete xlUp
  17.         ElseIf d(i).Rows.Count > 1 Or d(i).Areas.Count > 1 Then
  18.             d(i).Delete xlUp

  19.         End If
  20.     Next
  21. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# eric093


    感謝大大,不過,這對我來說太難了,我得慢慢研究!
另外,我用我會的方式寫,但有問題,大大可以幫我看一下嗎?

Sub 未入款2()

Application.ScreenUpdating = False
Dim j As Integer
Dim E As Range
Dim xragne, yrange, wrange As Range
Set E = Sheets("未入款").Range("e2")

Application.DisplayAlerts = False


Do While E <> ""
j = 1
     If E.Offset(j) = E Then
     
        
        If E.Offset(, 1) = E.Offset(j, 1) Then
          If E.Offset(, 34) <> E.Offset(j, 34) Then
               If yrange Is Nothing Then Set yrange = E
               If wrange Is Nothing Then Set wrange = E.Offset(1)
              Set yrange = Union(yrange, E)
              Set wrange = Union(wrange, E.Offset(1))
           End If
         
        End If
    Else
     If E(1).Offset(, 34) = "付款確認" Then
       If xragne Is Nothing Then Set xragne = E
              Set xragne = Union(xragne, E)

          End If
    End If
    Set E = E.Offset(1)
    j = j + 1
Loop
If Not xragne Is Nothing Then xragne.EntireRow.Delete
If Not yrange Is Nothing Then yrange.EntireRow.Delete
If Not wrange Is Nothing Then wrange.EntireRow.Delete
End Sub

未入款.rar (7.47 KB)

新人一枚

TOP

本帖最後由 GBKEE 於 2014-8-12 06:48 編輯

回復 4# eric093
xlsx 是沒有巨集的Excel檔, xlsm 才可存放程式碼.
  1. Option Explicit
  2. Sub 未入款2()
  3.     Application.ScreenUpdating = False
  4.     Dim j As Integer
  5.     Dim E As Range
  6.     '******宣告變數的型態 ,需依依的指定型態  **********
  7.     Dim xragne As Range, yrange As Range, wrange As Range
  8.     '*******************
  9.     Set E = Sheets("未入款").Range("e2")
  10.     Application.DisplayAlerts = False
  11.     Do While E <> ""                 'orderid 的迴圈
  12.         If E.Offset(, 34) = "付款確認" Then              '付款確認要刪除
  13.             If wrange Is Nothing Then
  14.                 Set wrange = E
  15.             Else
  16.                 Set wrange = Union(wrange, E)
  17.             End If
  18.         End If
  19.         j = 1
  20.         Do While E.Offset(j) <> ""                     '每一個orderid往下的迴圈
  21.             If E.Offset(j) = E Then                     ' 相同的 orderid
  22.                 If E.Offset(, 1) = E.Offset(j, 1) Then  ' 相同的 itemid 要刪除
  23.                     If wrange Is Nothing Then
  24.                         Set wrange = Union(E, E.Offset(j))
  25.                     Else
  26.                         Set wrange = Union(wrange, E, E.Offset(j))
  27.                     End If
  28.                 End If
  29.             End If
  30.             j = j + 1
  31.         Loop
  32.         Set E = E.Offset(1)
  33.     Loop
  34.     If Not wrange Is Nothing Then wrange.EntireRow.Delete
  35. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE


    謝謝版大,我來看一下我寫哪出錯了
新人一枚

TOP

回復 3# GBKEE

版主:問題是解決了,但我找了一些關於字典物件的資料,我有點搞不太懂,可以幫我開示嗎
            幫我解惑下面這段嗎
    Option Explicit
Sub Ex()
    Dim Rng As Range, d As Object, i As Variant, A As String
    Set d = CreateObject("scripting.dictionary")
    Set Rng =工作表1.Range("a1").CurrentRegion
    For i = 2 To Rng.Rows.Count
        A = Rng(i, 1) & "-" & Rng(i, 2)
        If d.EXISTS(A) Then   '字典物件的(key值)存在傳回True
            Set d(A) = Union(Rng.Rows(i), d(A)) ==========??
        Else
            Set d(A) = Rng.Rows(i)   ==========??

        End If
    Next
    For Each i In d.KEYS  ==========??

        If d(i).Rows.Count = 1 And InStr(d(i).Cells(3), "取消") = 0 Then
            d(i).Delete xlUp
        ElseIf d(i).Rows.Count > 1 Or d(i).Areas.Count > 1 Then
            d(i).Delete xlUp

        End If
    Next
End Sub
新人一枚

TOP

回復 7# eric093
  1. Dictionary 物件
  2. 可以是任何型式的資料的項目被儲存在陣列中。每個項目都與一個唯一的關鍵字相關。該關鍵字用來取出單個項目,通常是整數或字串,可以是除陣列外的任何型態。
複製代碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, d As Object, i As Variant, A As String
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Set Rng = 工作表1.Range("a1").CurrentRegion
  6.     For i = 2 To Rng.Rows.Count
  7.         A = Rng(i, 1) & "-" & Rng(i, 2)
  8.         If d.EXISTS(A) Then   '字典物件的(key值)存在傳回True
  9.             Set d(A) = Union(Rng.Rows(i), d(A)) ' ==========??
  10.         Else
  11.             Set d(A) = Rng.Rows(i)   '==========??
  12.         End If
  13.         MsgBox d(A).Address
  14.     Next
  15.     For Each i In d.KEYS  '==========??
  16.         MsgBox i
  17.         If d(i).Rows.Count = 1 And InStr(d(i).Cells(3), "取消") = 0 Then
  18.             d(i).Delete xlUp
  19.         ElseIf d(i).Rows.Count > 1 Or d(i).Areas.Count > 1 Then
  20.             d(i).Delete xlUp
  21.         End If
  22.     Next
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

執行前:


執行結果:



Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, TT, T1$, T2$, T3$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([C2], Cells(Rows.Count, "A").End(3)): Brr = xR
For i = 1 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T1 & "|" & T2
   If Y(TT) <> "成功" Then Y(TT) = T3: Y(TT & "|r") = i
Next
For Each TT In Y.keys
   If TT Like "*|r" Or Y(TT) = "成功" Then GoTo i00
   R = R + 1: For j = 1 To 3: Brr(R, j) = Brr(Y(TT & "|r"), j): Next
i00: Next
If R = 0 Then GoTo i01
xR.Offset(1, 0).ClearContents: xR.Resize(R, 3) = Brr
i01: Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 閒人無樂趣,忙人無是非。
返回列表 上一主題