標題: 資料轉寫+VBA月份流水號 [打印本頁]

---

作者: man65boy    時間: 2012-5-5 21:17     標題: 資料轉寫+VBA月份流水號

本帖最後由 man65boy 於 2012-5-5 21:23 編輯

如何在檔案的A欄裡設置VBA自動判讀的流水號,小弟有試過函數應用，但，因為勾選"自取"後，轉寫到Sheet2時，函數會重新再編號，這樣會使資料無法變成當初所編的編碼。
請教各位先進老師們，如何讓A欄的流水號，在轉寫後，依舊保持著原來的編碼，謝謝!
[attach]10820[/attach]

---

作者: play9091    時間: 2012-5-5 22:15

本帖最後由 play9091 於 2012-5-5 22:18 編輯

可以試試看貼到"Sheet2"上面的時候，用"貼上值"，這樣子就不會跑掉了！

1.   If Not Rng Is Nothing Then
   
2.      Rng.Copy
   
3.      Sheet2.[A65536].End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
4.      Rng.EntireRow.Delete
   
5.   End If

複製代碼

---

作者: man65boy    時間: 2012-5-6 01:06

回復 2# play9091


    謝謝大大的修改建議，但是， 小弟在A欄使用的函數=TEXT(B2,"mm")&"-"&TEXT(SUMPRODUCT((TEXT($B$1:$B2,"yymm")=TEXT(B2,"yymm"))*1),"000")，資料不轉寫走的話，沒問題的，
  可是 SHEET1的A欄函數是會隨著轉寫走的資料變動重排，所以小弟希望能在A欄使用VBA流水號，

---

作者: oobird    時間: 2012-5-6 10:12

Sub yy()
    Dim b(12) As Byte, c As Range
    For Each c In Range([b2], [b2].End(4))
        b(Month(c)) = b(Month(c)) + 1
        c(1, 0).Value = Format(Month(c), "00") & "-" & Format(b(Month(c)), "000")
    Next
End Sub

---

作者: man65boy    時間: 2012-5-6 15:05

回復 4# oobird


    謝謝oobird大大的回答，轉寫到sheet2的資料正確無誤，但，sheet1的資料只要在按鈕一下，就重新排列了，這樣會使sheet1的編號資料跟sheet2編號資料重複，
小弟想得不夠多，說的不清楚，抱歉!
   流水號重新說明:sheet1的A 欄編號為2012-05-001<<加上年份(這樣比較像唯一碼)，一樣轉寫後，在按鈕編碼時，不能和sheet2編號資料重複，簡單來說，轉寫2012-05-002到sheet2時，
sheet1A欄裡不能在有相同的sheet2A欄的流水號，這樣才能保留當初設定的碼號是唯一，麻煩各位老師幫忙!


[attach]10825[/attach]

---

作者: register313    時間: 2012-5-8 00:43

本帖最後由 register313 於 2012-5-8 08:57 編輯

回復 5# man65boy

1. Sub yy()
   
2. '建立字典物件
   
3. Set d = CreateObject("scripting.dictionary")
   
4. '在Sheet2工作表b2儲存格~b欄最後一格作迴圈
   
5. For Each c In Sheet2.Range(Sheet2.[b2], Sheet2.[b2].End(4))
   
6.   '若b欄儲存格之內容為空值則離開迴圈
   
7.   If c = "" Then Exit For
   
8.   '計算同年同月分別出現之次數
   
9.   d(Year(c) & Month(c)) = d(Year(c) & Month(c)) + 1
   
10. '返回迴圈
    
11. Next
    
12. '在Sheet1工作表b2儲存格~b欄最後一格作迴圈
    
13. For Each c In Sheet1.Range(Sheet1.[b2], Sheet1.[b2].End(4))
    
14.   '計算Sheet1工作表中同年同月分別出現之次數(含之前Sheet2工作表)
    
15.   d(Year(c) & Month(c)) = d(Year(c) & Month(c)) + 1
    
16.   '若b欄儲存格之內容為空值則 a欄儲存格之內容=b欄之 年-月-流水號
    
17.   If c(1, 0).Value = "" Then c(1, 0).Value = Format(c, "yyyy-mm") & "-" & Format(d(Year(c) & Month(c)), "000")
    
18. '返回迴圈
    
19. Next
    
20. End Sub

複製代碼

---

作者: man65boy    時間: 2012-5-8 01:33

回復 6# register313


    感謝register313大大完美的解答，可否請大大在程式碼中備註語法，好讓小弟學習，再次的感謝你。

---

作者: Andy2483    時間: 2023-4-7 14:31

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

執行前:
[attach]36096[/attach]

執行結果:
[attach]36097[/attach]


Option Explicit
Sub TEST()
Dim Brr, Y, i&, j%, T$, xR As Range, Sh
Set Y = CreateObject("Scripting.Dictionary")
Sh = Array(, Sheets("sheet2"), Sheets("sheet1"))
For j = 1 To 2
   Set xR = Range(Sh(j).[A1], Sh(j).Cells(Rows.Count, "F").End(3))
   Brr = xR
   For i = 2 To UBound(Brr)
      T = Format(Brr(i, 2), "YYYY-MM-")
      Y(T) = Y(T) + 1
      Brr(i, 1) = T & Format(Y(T), "000")
   Next
   If j = 2 Then
      Intersect(xR.Offset(1, 0), [A:A]).ClearContents
      xR = Brr
   End If
Next
Set Y = Nothing: Set xR = Nothing: Set Sh = Nothing: Erase Brr
End Sub

---

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