2008年7月15日 星期二

VBA : FIND

VBA : FIND

Sub xfind()
' 本程式必須在 xxxxx入數 檔案中運行

Sw1name = ActiveWorkbook.Name
Sw2name = "KP-101賬簿" & ".xls"

my_array = Range("A2").CurrentRegion.Value '讀取原始資料,由 A2格開始,直至結尾。

a_rows = UBound(my_array, 1) '取得Aarray 的最大行數

i = 2 '第 x 行,此行累加,因有標題列,故由 2 開始。
j = 1 '第 x 欄,

Do While a_rows > i - 1

Sw1date = my_array(i, j)
Sw1code = my_array(i, j + 1) '此 j 欄定位為「檯號」
Sw1code1 = Left(Sw1code, 2) '讀取所在儲存格頭兩個數字,即分組號
Sw1code2 = Right(Sw1code, 2) '讀取所在儲存格後兩個數字,即分檯號
Sw1payout = my_array(i, j + 2)


Workbooks(Sw2name).Worksheets(Sw1code1).Activate '啟動賬簿及所屬分頁

Set TableNo = Rows(1).Find(What:=Sw1code2) '尋出所屬分頁之分檯

TC = TableNo.Column
icount = Cells(65536, TC).End(xlUp).Row '.Offset(, 2) '讀取分檯之資料數 並 移至該分檯之第一空格
Cells(icount + 1, TableNo.Column) = my_array(i, j) '寫入日期
Cells(icount + 1, TableNo.Column + 1) = my_array(i, j + 2) '寫入「賠彩數」

If icount = 2 Then
Cells(icount + 1, TableNo.Column + 2) = my_array(i, j + 2)
Else
Cells(icount + 1, TableNo.Column + 2) = my_array(i, j + 2) + Cells(icount, TableNo.Column + 2)
End If

i = i + 1

icount = icount + 1

Loop

End Sub

沒有留言: