[發問] 如何建立只選取''非隱藏儲存格''的循環語句

HSINLI

如題，程式碼見附件可以執行，但計算出來都不是想要的結果，
一一檢查發現好像是循環語句將篩選結果的“隱藏儲存格”的值也算進去了，但我只需要非隱藏儲存格的值；
自己有試過一些方法offset、resize...但無法解決，故想要來請教一下各位前輩，謝謝！

這程式主要目的是要將交易紀錄（工作表a)做整理，整理出非重複的項目，並計算各非重複項目現有的股數與成本
我的想法是：
先利用AdvancedFilter，將非重複的項目貼於另一工作表b
藉由工作表b有的項目，去利用循環語句一一篩選出工作表a裡該項目的重複項目
然後利用IF判斷是bought還是sold，bought為+，sold為-，再利用循環語句加總至工作表b的儲存格內

如果有更好的寫法就更感激了，謝謝！

1. Sub 現有交易部位整理()
   
2. 
   
3. Dim po As Worksheet
   
4. Dim 交 As Worksheet
   
5.    
   
6.     Set po = Sheets("position")
   
7.     Set 交 = Sheets("交易紀錄")
   
8.    
   
9.     Application.ScreenUpdating = False
   
10.    
    
11.     '過濾出所有重複的symbol，並將之貼至sheets("position")的a5處
    
12.       交.Range("d:d").AdvancedFilter xlFilterInPlace, Range("d:d"), , True
    
13.       交.Range("d:d").SpecialCells(xlCellTypeVisible).Copy po.Range("a5")
    
14.     '刪除標題
    
15.       po.Range("a5").EntireRow.Delete
    
16.    
    
17.     '在Sheets("交易紀錄")篩選出在Sheets("交易紀錄")上的symbol，並加以計算QTY貼於Sheets("交易紀錄")
    
18.     Dim i As Integer
    
19.     Dim last As Integer
    
20.     Dim ipo As Integer
    
21.     Dim lastpo As Integer
    
22.    
    
23.     lastpo = po.Range("a5").End(xlDown).Row
    
24.    
    
25.     For ipo = 1 To lastpo
    
26.       '利用貼至Sheets("position")的不重複物件，一一來篩選原表格所含有該物件的所有項目
    
27.       交.ListObjects("表格1").Range.AutoFilter field:=4, Criteria1:=po.Range("a" & ipo)
    
28.       
    
29.       '"想要"得到篩選出來項目的數目(不包括隱藏)
    
30.       last = 交.Range("d2").End(xlDown).Row
    
31.       For i = 1 To last
    
32.       '如果在ACT.那格是bought的話qty得值為正，ACT.那格是Sold的話qty的值為負，循環加總至Sheets("position")對應的總量儲存格
    
33.              If 交.Range("c" & i + 1) = "Bought" Then
    
34.                  po.Range("c" & ipo + 4) = po.Range("c" & ipo + 4) + 交.Range("e" & i)
    
35.              ElseIf 交.Range("c" & i + 1) = "Sold" Then
    
36.                   po.Range("c" & ipo + 4) = po.Range("c" & ipo + 4) - 交.Range("e" & i)
    
37.               End If
    
38.             Next i
    
39.        Next ipo
    
40.     Application.ScreenUpdating = True
    
41. 
    
42. End Sub

複製代碼

活頁簿3.xlsx.zip (10.08 KB)

要整理之表格，無程式碼
下載次數: 7

2015-7-8 21:50

GBKEE

回復 6# HSINLI
想請問如果發生這種錯誤的話，要怎麼找出問題在哪裡啊！？
待你VBA 的經驗值提升後,應可自行找出.

HSINLI

可以了！！謝謝g大
想請問如果發生這種錯誤的話，要怎麼找出問題在哪裡啊！？
想說以後自己先嘗試處理就好，不用麻煩您

GBKEE

回復 4# HSINLI
已找到附檔程式碼的錯誤如下

1. For i = 2 To 交.Range("d2").End(xlDown).Row
   
2.             If 交.Range("c" & i).RowHeight Then 'RowHeight > 0 儲存格不是隱藏的
   
3.                 If 交.Range("c" & i) = "Bought" Then
   
4.                     '這錯誤 ipo沒有給值 ********
   
5.                     po.Range("c" & ipo) = po.Range("c" & ipo) + 交.Range("e" & i)
   
6.                     '***************************
   
7.                 ElseIf 交.Range("c" & i) = "Sold" Then
   
8.                     po.Range("c" & ipo) = po.Range("c" & ipo) - 交.Range("e" & i)
   
9.                 End If
   
10.             End If
    
11.     Next i

複製代碼

請將  If 交.Range("c" & i).RowHeight Then 'RowHeight > 0 儲存格不是隱藏的
套到你第一帖的程式碼試看看

HSINLI

在這裏～～

HSINLI

了解了！！
利用行高>0來篩選出非隱藏的儲存格
學到一課，謝謝指教！
g大的寫法晚上再慢慢研究！

還想再請問一下，
程式碼這部分的執行，常常在
po.Range("c" & ipo) = po.Range("c" & ipo) + 交.Range("e" & i)
這句出現“1004”'range'方法('_worksheet'物件)失敗
有時會發生有時又不會，不知是何種緣故？或哪裡需要改進？

1. For i = 2 To 交.Range("d2").End(xlDown).Row
   
2.             If 交.Range("c" & i).RowHeight Then 'RowHeight > 0
   
3.                 If 交.Range("c" & i) = "Bought" Then
   
4.                     po.Range("c" & ipo) = po.Range("c" & ipo) + 交.Range("e" & i)
   
5.                 ElseIf 交.Range("c" & i) = "Sold" Then
   
6.                     po.Range("c" & ipo) = po.Range("c" & ipo) - 交.Range("e" & i)
   
7.                 End If
   
8.             End If
   
9.         Next i

複製代碼

GBKEE

回復 1# HSINLI
可修改如下

1.   For i = 2 To 交.Range("d2").End(xlDown).Row
   
2.             If 交.Range("c" & i).RowHeight Then 'RowHeight > 0 '儲存格不是隱藏的
   
3.                 If 交.Range("c" & i) = "Bought" Then
   
4.                     po.Range("c" & ipo) = po.Range("c" & ipo) + 交.Range("e" & i)
   
5.                 ElseIf 交.Range("c" & i) = "Sold" Then
   
6.                     po.Range("c" & ipo) = po.Range("c" & ipo) - 交.Range("e" & i)
   
7.                 End If
   
8.             End If
   
9.         Next i

複製代碼

也可如此

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim po As Worksheet, 交 As Worksheet
   
4.     Dim ipo As Integer, Bought As Integer, Sold As Integer
   
5.     Set po = Sheets("position")
   
6.     Set 交 = Sheets("交易紀錄")
   
7.     Application.ScreenUpdating = False
   
8.     po.Range("a5", po.[A5].End(xlDown)) = ""
   
9.     'AdvancedFilter xlFilterCopy 在指定的其他範圍的欄位(無字串,複製全部欄位。有字串,須為資料庫的欄位)
   
10.     交.ListObjects("表格1").Range.Range("D:D").AdvancedFilter xlFilterCopy, , po.Range("a5"), True
    
11.       
    
12.     'AdvancedFilter(進階篩選)  ,AutoFilter(自動篩選)
    
13.     'AdvancedFilter Action:= xlFilterInPlace  在篩選的範圍顯示篩選後的資料
    
14.     With po
    
15.         For ipo = 6 To .Range("a5").End(xlDown).Row          '
    
16.             交.ListObjects("表格1").Range.AutoFilter field:=4, Criteria1:=.Range("a" & ipo)
    
17.             With 交.ListObjects("表格1").Range
    
18.                     .AutoFilter field:=3, Criteria1:="Bought"
    
19.                     Bought = Application.Sum(.Range("E:E").SpecialCells(xlCellTypeVisible))
    
20.                     'Application.Sum 工作表函數
    
21.                     '.SpecialCells [特殊的儲存格] (xlCellTypeVisible) 參數:=可見的儲存格
    
22.                     .AutoFilter field:=3, Criteria1:="Sold"
    
23.                     Sold = Application.Sum(.Range("E:E").SpecialCells(xlCellTypeVisible))
    
24.             End With
    
25.             .Cells(ipo, "C") = Bought - Sold
    
26.         Next
    
27.     End With
    
28.     交.ListObjects("表格1").Range.AutoFilter  '沒有準則 = 取消自動篩選
    
29.     Application.ScreenUpdating = True
    
30. End Sub

複製代碼