Hsieh

回復 19# 198188

如果我寫這句替代上面兩句fs = "W:\PIHK\DOCS RECEIVED N RELEASED RECORD.xlsx"
第5行這句
With Workbooks.Open(fd & fs)
就要改成
With Workbooks.Open(fs)

Join(Ar, "、"): Erase 這句是什麼意思？
程式語法不能只讀一半，在同一行敘述使用冒號，相當於兩行敘述
Join(Ar, "、") →  會得到陣列元素用頓號、連接的字串
Erase Ar →  是清空陣列

程式寫得對不對，執行一下就知道結果啦

198188

回復 21# Hsieh

下載 (56.67 KB)

2013-3-9 23:13

        感謝解釋，雖然不太明白，但會多嘗試。
另外我想問
如果H 欄如附件那樣合併，是否無法讀取？
只有214110 有資料
下面幾個是不是等於空格沒資料？
210695
214162
213924
212340
212341
211914
211915
212857

Hsieh

回復 22# 198188
這樣的程式與樓上程式碼比較看看應該就容易了解

1. Sub ex()
   
2. Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
   
3. fd = ThisWorkbook.Path & "\"  '資料來源目錄
   
4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '資料來源檔案(含副檔名)
   
5. With Workbooks.Open(fd & fs)
   
6.   Set Sh = .Sheets("收件記錄")
   
7.       With ThisWorkbook.Sheets("State")
   
8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
   
9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
   
10.             If Not Rng Is Nothing Then
    
11.                For Each C In Sh.Range(Rng, Sh.Cells(Sh.Rows.Count, 4).End(xlUp))
    
12.                   If C = A And InStr(UCase(C.Offset(, 4).MergeArea(1)), "OBL") > 0 Then
    
13.                      ReDim Preserve Ar(s)
    
14.                      Ar(s) = C.Offset(, 4).MergeArea(1)
    
15.                      s = s + 1
    
16.                   End If
    
17.                 Next
    
18.             If s > 0 And A.Offset(, 9) = "" Then
    
19.                A.Offset(, 9) = Join(Ar, "、")
    
20.                Erase Ar
    
21.                s = 0
    
22.                   Else
    
23.                A.Offset(, 9) = ""
    
24.             End If
    
25.             End If
    
26.          Next
    
27.       End With
    
28.     .Close
    
29. End With
    
30. End Sub

複製代碼

198188

回復 23# Hsieh


    原理明白，只是語法用法末清晰如何用，謝！
如果合併幾個儲存格是否讀不了？如上圖？

Hsieh

回復 24# 198188
善用F1說明與逐行偵錯才能對語法徹底了解
你問合併儲存格是否可行?
表示你根本沒有執行測試
沒有勇氣測試只會讓你永遠停頓
除非有證明樓上程式碼無法達成需求
且說明清楚問題點，否則此問題將不再回應

198188

回復 25# Hsieh


    合併一問，之前已試過，只有第一個可讀取，其余是空格。我問題寫得不清楚，抱歉。
應該是不是有方法做到？

Hsieh

回復 26# 198188
你怎麼測試的?

下載 (747.03 KB)

2013-3-10 10:18

GBKEE

回復 20# 198188
With Sheet2                 (這句是否改With W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx ？）但是好像不對？？

如果我寫這句替代上面兩句fs = "W:\PIHK\DOCS RECEIVED N RELEASED RECORD.xlsx"
第5行這句
With Workbooks.Open(fd & fs)
就要改成
With Workbooks.Open(fs)

1.              With Workbooks.Open(fs)
   
2.                      Set Sh=.Sheets("收單記錄SHEET")
   
3.              End With
   
4. 
   
5.               With Sh  '->如此 Sh 已替代為為W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx"的 收單記錄SHEET
   
6.             
   
7.                End With

複製代碼

198188

回復 27# Hsieh


    現在可以了，可能是excel有點衝突。
不知道為什麼有時候excel的程式本身一直沒問題，但是有時候會突然出現問題，但是重新啟動excel 後或者重新啟動電腦後，就沒有問題了。

198188

回復 28# GBKEE

1. Sub Ex()
   
2. Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
   
3.     Dim R As Range, E As Range
   
4.     With Sheets("State")                         '*** 須改為: Test.xlsm的State Sheet
   
5.         Set R = .Cells(1, "a")          'A1開始
   
6.                         
   
7.          fs = "C:\Documents and Settings\USER\桌面\DOCS RECEIVED N RELEASED RECORD.xlsx"
   
8. With Workbooks.Open(fs)
   
9.   Set Sh = .Sheets("收件記錄")
   
10.   Do Until R = "" '離開迴圈的條件:  A欄的 儲存格=""
    
11.       With Sh '*** 須改為: W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx"
    
12.               
    
13.                 Set Rng = .Columns("D").Find(R, lookat:=xlWhole)
    
14.                  If Not Rng Is Nothing Then
    
15.                     With .Columns("D")
    
16.                         .Replace R, "=ABC", xlWhole                 '修改"尋找的字串" = 沒定義的名稱
    
17.                         Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors) '儲存格有錯誤值的特定範圍
    
18.                         Rng.Value = R                               '沒定義的名稱 改回 "尋找的字串"
    
19.                         For Each E In Rng.Offset(0, 4)              'D欄位移4欄=H欄
    
20.                             If InStr(UCase(E), "OBL") Then          'H欄的字元內包含"OBL"三個字
    
21.                                                                     'UCase(E) 轉換為大寫
    
22.                                 R.Offset(0, 9) = E.Value            'R.Offset(0, 9)-> A欄位移到 J欄
    
23.                                 'Test.xlsm的State Sheet->J欄=DOCS RECEIVED N RELEASED RECORD.xlsx"->H欄的字元
    
24.                                 Exit For    '有找到 "OBL" 離開迴圈                          '
    
25.                             End If
    
26.                        Next
    
27.                     End With                '.Columns("D")
    
28.                 End If
    
29.             End With                        'Sheet2
    
30.             Set R = R.Offset(1)             '下移到 A2
    
31.      Loop
    
32.     End With                                'Sheet1
    
33. End With
    
34. End Sub

複製代碼

這樣就可以了。
不過這個程式，如果DOCS RECEIVED N RELEASED RECORD.xlsx的H欄幾列是合併的話，就讀不了只有第一個才會有資料，第二列開始就無資料。