帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2012-5-5 21:17 | 只看該作者

資料轉寫+VBA月份流水號

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

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

資料轉寫加流水號.rar (11.25 KB)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

8^#

發表於 2023-4-7 14:31 | 只看該作者

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

執行前:

執行結果:

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

7^#

發表於 2012-5-8 01:33 | 只看該作者

回復 6# register313

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

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

6^#

發表於 2012-5-8 00:43 | 只看該作者

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

回復 5# man65boy

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

複製代碼

TOP

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

5^#

發表於 2012-5-6 15:05 | 只看該作者

回復 4# oobird

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

資料轉寫加流水號2.rar (11.46 KB)

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

4^#

發表於 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

TOP

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

3^#

發表於 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流水號，

TOP

play9091

中學生 Rank: 2

帖子: 87
主題: 24
精華: 0
積分: 122
點名: 0
作業系統: win 7
軟體版本: 2016
閱讀權限: 20
性別: 男
註冊時間: 2011-7-9
最後登錄: 2018-1-16

2^#

發表於 2012-5-5 22:15 | 只看該作者

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

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

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

複製代碼

初學VBA乍到twbts

TOP