Board logo

標題: [發問] 如何建立只選取''非隱藏儲存格''的循環語句 [打印本頁]
作者: HSINLI    時間: 2015-7-8 21:51     標題: 如何建立只選取''非隱藏儲存格''的循環語句

本帖最後由 HSINLI 於 2015-7-8 21:53 編輯

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

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

如果有更好的寫法就更感激了，謝謝！
  1. Sub 現有交易部位整理()

  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

  42. End Sub
複製代碼
[attach]21350[/attach]
作者: GBKEE    時間: 2015-7-9 08:57

回復 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
複製代碼
作者: HSINLI    時間: 2015-7-9 12:46

了解了！！
利用行高>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
複製代碼
作者: HSINLI    時間: 2015-7-9 21:29

在這裏∼∼
作者: GBKEE    時間: 2015-7-10 05:30

回復 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    時間: 2015-7-10 11:46

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

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)