| ページ一覧 | ブログ | twitter |  書式 | 書式(表) |

MyMemoWiki

「Excel VBA オートフィルタをで行が隠れているか判定」の版間の差分

提供: MyMemoWiki
ナビゲーションに移動 検索に移動
 
1行目: 1行目:
 
======
 
======
  Cells(r, c).Entire[[R]]ow.Hidden
+
  Cells(r, c).EntireRow.Hidden
  
 
===オートフィルタ済みで見えている行のみで上の行と重複があれば"1"を設定する例===
 
===オートフィルタ済みで見えている行のみで上の行と重複があれば"1"を設定する例===
  Sub Duplicate[[R]]owCheck_Click()
+
  Sub DuplicateRowCheck_Click()
     Const STA[[R]]T_[[R]]OW As Integer = 4
+
     Const START_ROW As Integer = 4
     Const TA[[R]]GET_COL As Integer = 5
+
     Const TARGET_COL As Integer = 5
     Const [[R]]ESULT_COL As Integer = 6
+
     Const RESULT_COL As Integer = 6
 
      
 
      
 
     Dim r      As Long
 
     Dim r      As Long
13行目: 13行目:
 
     Dim temp    As String
 
     Dim temp    As String
 
     Dim pre    As String
 
     Dim pre    As String
     Dim pre[[R]]ow As Long
+
     Dim preRow As Long
 
      
 
      
     r = STA[[R]]T_[[R]]OW
+
     r = START_ROW
 
     Do
 
     Do
         s = Cells(r, TA[[R]]GET_COL).Text
+
         s = Cells(r, TARGET_COL).Text
         If Not Cells(r, TA[[R]]GET_COL).Entire[[R]]ow.Hidden Then
+
         If Not Cells(r, TARGET_COL).EntireRow.Hidden Then
 
             temp = s
 
             temp = s
 
                          
 
                          
 
             If pre = temp Then
 
             If pre = temp Then
                 Cells(pre[[R]]ow, [[R]]ESULT_COL).Value = "1"
+
                 Cells(preRow, RESULT_COL).Value = "1"
                 Cells(r, [[R]]ESULT_COL).Value = "1"
+
                 Cells(r, RESULT_COL).Value = "1"
 
             End If
 
             End If
 
              
 
              
 
             pre = temp
 
             pre = temp
             pre[[R]]ow = r
+
             preRow = r
 
         Else
 
         Else
             Cells(r, [[R]]ESULT_COL).Value = ""
+
             Cells(r, RESULT_COL).Value = ""
 
         End If
 
         End If
 
         r = r + 1
 
         r = r + 1

2022年5月19日 (木) 14:52時点における最新版

==

Cells(r, c).EntireRow.Hidden

オートフィルタ済みで見えている行のみで上の行と重複があれば"1"を設定する例

Sub DuplicateRowCheck_Click()
    Const START_ROW As Integer = 4
    Const TARGET_COL As Integer = 5
    Const RESULT_COL As Integer = 6
    
    Dim r       As Long
    Dim pn      As String
    Dim s       As String
    Dim temp    As String
    Dim pre     As String
    Dim preRow  As Long
    
    r = START_ROW
    Do
        s = Cells(r, TARGET_COL).Text
        If Not Cells(r, TARGET_COL).EntireRow.Hidden Then
            temp = s
                        
            If pre = temp Then
                Cells(preRow, RESULT_COL).Value = "1"
                Cells(r, RESULT_COL).Value = "1"
            End If
            
            pre = temp
            preRow = r
        Else
            Cells(r, RESULT_COL).Value = ""
        End If
        r = r + 1
        DoEvents
    Loop While Trim(s) <> ""
    
    MsgBox "終了"
End Sub