返回列表 上一主題 發帖

[發問] 編號前七碼相同者只要銷案日空值則其他版次皆刪除

[發問] 編號前七碼相同者只要銷案日空值則其他版次皆刪除

DEAR ALL 大大
1.資料庫如圖一
2.需求-編號前七碼相同者只要銷案日空值則其他版次皆刪除
2.1 例: C123456 與 C123456A 組.因 銷案日皆有值為同一故保留.
          D123456 與 D123456A 與 D123456B 為同一組因D123456B銷案日為空白故ALL刪除
       E123456 與 E123456A 為同一組因E123456銷案日為空白故ALL刪除
2.2 結果如圖二
3.煩不吝賜教  THANKS*10000

圖一
編號         項目   使用者     收件日           銷案日
C123456      1        1          2017/08/04        2017/08/12
C123456A      1        1          2017/08/04        2017/08/12
D123456        1        1          2017/08/04        2017/08/12
D123456A      1        1          2017/08/04        2017/08/12
E123456        1        1          2017/08/04         
D123456B      1        1          2017/08/04
E123456A      1        1          2017/08/05        2017/08/06

圖二
C123456        1        1          2017/08/04        2017/08/12
C123456A      1        1          2017/08/04        2017/08/12
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

隨意窩 "EXCEL迷"  blog  或 http://blog.xuite.net/hcm19522/twblog
已收集3600篇 EXCEL函數
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

DEAR  大大
SORRY 未說清處
小弟是要使用VBA
原圖一資料庫於   SHEET1
要將圖二資料導入 SHEET2
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

DEAR ALL 大大
小弟分如下4組方完成
請教如何一組VAB即完成之方式 煩不吝賜教

Sub 條件資料庫A()
Application.Run "條件資料庫A1"
Application.Run "條件資料庫A2"
Application.Run "條件資料庫A3"
Sheet3.[a2:f65536].ClearContents
  X = Sheet1.[A65536].End(xlUp).Row
  Y = Sheet3.[A65536].End(xlUp).Row
For M = 2 To X
If Sheet1.Cells(M, 9) = 0 Then
  Sheet3.Cells(Y + 1, 1).Resize(, 6).Value = Sheet1.Cells(M, 1).Resize(, 6).Value
    Y = Y + 1
End If
Next
End Sub

Sub 條件資料庫A1()
Sheet1.[G2:G65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
For M = 2 To X
  Sheet1.Cells(M, 7) = Mid(Sheet1.Cells(M, 1), 1, 7)
  Next
End Sub

Sub 條件資料庫A2()
Sheet1.[H2:H65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
For M = 2 To X
  If Sheet1.Cells(M, 5) = "NULL" Or Sheet1.Cells(M, 5) = "" Or Sheet1.Cells(M, 5) = " " Then
    Sheet1.Cells(M, 8) = Sheet1.Cells(M, 7)
  End If
  Next
End Sub

Sub 條件資料庫A3()
Sheet1.Select
Range("A1").Select
Sheet1.[I2:I65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
For M = 2 To X
   Sheet1.Cells(M, 9) = Application.CountIf(Sheet1.Range("H:H"), Sheet1.Cells(M, 7))
Next
End Sub
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 4# rouber590324
試試看
  1. Sub ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets(1)
  5. For Each A In .Range(.[A1], .[A1].End(xlDown))
  6.   If d(Left(A, 7)) = "" Then
  7.      d(Left(A, 7)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
  8.      Else
  9.      d(Left(A, 7)) = d(Left(A, 7)) & Chr(10) & Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
  10.   End If
  11. Next
  12. For Each ky In d.keys
  13.   ar = Split(d(ky), Chr(10))
  14.   For Each c In ar
  15.      If Split(c, ";")(4) = "" Then d.Remove ky
  16.   Next
  17. Next
  18. On Error Resume Next
  19. For Each ky In d.keys
  20.   ar = Split(d(ky), Chr(10))
  21.   For Each c In ar
  22.   ay = Split(c, ";")
  23.   ay(3) = CDate(ay(3))
  24.   ay(4) = CDate(ay(4))
  25.     Sheets(2).Cells(r + 1, 1).Resize(, 5) = ay
  26.     r = r + 1
  27.   Next
  28. Next
  29. End With
  30. End Sub
複製代碼
學海無涯_不恥下問
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 3# rouber590324
請參考。
依編號銷案.rar (17.64 KB)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

DEAR Hsieh 大大
1.出現型態不符合之BUG停於ay(3) = CDate(ay(3))????

DEAR Kubi 大大
小弟使用公司電腦無法下載.rar檔案.還是感謝您回覆.

Sub 條件資料庫A4()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With Sheets(1)
For Each A In .Range(.[A1], .[A1].End(xlDown))
  If d(Left(A, 7)) = "" Then
     d(Left(A, 7)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
     Else
     d(Left(A, 7)) = d(Left(A, 7)) & Chr(10) & Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
  End If
Next
For Each ky In d.keys
  ar = Split(d(ky), Chr(10))
For Each c In ar
     If Split(c, ";")(4) = "" Then d.Remove ky
  Next
Next
'On Error Resume Next
For Each ky In d.keys
  ar = Split(d(ky), Chr(10))
  For Each c In ar
  ay = Split(c, ";")
  ay(3) = CDate(ay(3))
  ay(4) = CDate(ay(4))
    Sheets(2).Cells(r + 1, 1).Resize(, 5) = ay
    r = r + 1
  Next
Next
End With
End Sub
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

DEAR Hsieh 大大
SORRY 已找到問題.感謝您之指導 THANKS*10000
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題