vba校對統計不同工作薄(2)

2021-06-19 00:18:45 字數 2548 閱讀 4774

option explicit

sub find()

dim myworkbook as workbook

dim ws as worksheet

dim rg as range, rg2 as range

dim rgfirst as range

dim nlength as integer, i as integer

dim strtmp as string

dim strfilepath as string '第三方2資料夾中匯入xml檔名

dim nnum as integer '銷售件數

dim s() as string

'nlength = 0

strtmp = ""

on error goto errex

set rgfirst = cells(activecell.row, activecell.column)

do while rgfirst.value <> "" '*************迴圈**********************************

nlength = 0

strtmp = rgfirst.value

s() = split(strtmp, ".")

if ubound(s) <> 1 then

msgbox (strtmp & "選擇有誤!")

exit sub

end if

strtmp = "2013-" & s(0) & "-" & s(1)

set ws = thisworkbook.sheets(3)

ws.columns("e:e").numberformatlocal = "yyyy-m-d"

ws.columns("g:g").numberformatlocal = "yyyy-m-d"

set rg2 = ws.cells(rgfirst.row, 1)

rg2 = s(0)

rg2.offset(0, 1) = rgfirst.offset(0, 1) '發貨地

rg2.offset(0, 4) = strtmp '發貨日期

rg2.offset(0, 7) = rgfirst.offset(0, 3) '發貨件數

rg2.offset(0, 12) = rgfirst.offset(0, 4)

'strfilepath = thisworkbook.path & "/四川科倫每天銷售發貨明細.xls"

'nnum = rgfirst.offset(0, 2)

set myworkbook = workbooks.item("四川科倫每天銷售發貨明細.xls")

'set myworkbook = activeworkbook

for i = 2 to myworkbook.sheets.count '''''''''''

set ws = myworkbook.worksheets(i)

set rg = ws.cells(1, 1)

do while rg.row <> ws.usedrange.rows.count + ws.usedrange.row - 1 + 1

if instr(rg.offset(0, 4).value, rg2.offset(0, 1)) > 0 and _

rg.offset(0, 8).value = rg2.offset(0, 4) and _

rg.offset(0, 5).value = rg2.offset(0, 7) then

rg2.offset(0, 2) = rg.offset(0, 4) '收貨地詳細位址

rg2.offset(0, 3) = rg.offset(0, 3) '收貨單位

rg2.offset(0, 5) = rg.offset(0, 1) '發貨單號

rg2.offset(0, 6) = rg.offset(0, 0) '單據日期

exit for

end if

set rg = rg.offset(1, 0)

loop

next ''''''''''''''''''''''''''

if rg.row = ws.usedrange.rows.count + ws.usedrange.row then

msgbox strtmp & "銷售單沒找到!可能錯誤!"

rg2.entirerow.interior.color = 65535

exit sub

end if

set rgfirst = rgfirst.offset(1, 0)

rgfirst.select

loop ' *************迴圈**********************************

exit sub

errex:

msgbox (strtmp & "的執行有錯誤,請檢查!")

end sub

sub macro1()

end sub

廣州老師 同工不同薪酬現象

這兩天的 羊城晚報 首次大膽揭露了廣州老師 同工不同薪酬現象,同一級別的老師,省屬,市屬,區屬的老師每月相差1000多元。我老爸也是教師,教數學,更了解他的辛苦,現在退休了,依然清貧,也就3k多點。本次報道引來廣大教師熱烈反響,下面是相關連線 老師收入調查續 渴望同工同酬,差異大難接受 教師同工同城...

VBA 統計檔案個數

說明 1第乙個sheet名為sheet1,第二個名為step 2兩個sheet相比較,如果相同,將檔案個數放到sheet1的第二列 sub countstep countstep macro keyboard shortcut ctrl shift t dim sheetycnt as intege...

不同工程的入口函式總結

今天編譯遇到了如下問題 error lnk2019 unresolved external symbol wmain referenced in function mainwcrtstartup 在網上瀏覽則發現 不同的工程下面有不同的入口函式,win32的主程式為winmain.windows的控...