Excel 查找符合條件的第一個儲存格

excel

ky826 2021-03-23 14:32:56 ‧ 1072 瀏覽

分享至

想以excel 查找符合條件的第一個儲存格
範例
A B C
1 5 3
2 4
3 3
4 6
5 3

需要查找B欄小於4的第一個值(ex: B3), 於C1回傳該index為3(A3); 第二個以後小於4(ex: B5)不計

希望以worksheet function 為首選, 或VBA(該sheet已有其他VBA條件判定)

煩請指教, 先謝過各位大神

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

koro_michael

iT邦新手 2 級 ‧ 2021-03-23 15:14:39

最佳解答

Sub 按鈕1_Click()
    For Each c In Worksheets(1).Range("B:B").Cells
        If c.Value < 4 Then
            Worksheets(1).Range("C1") = c.Offset(columnOffset:=-1).Value
            Exit For
        End If
    Next
End Sub

回應 19
分享
檢舉

看更多先前的回應...收起先前的回應...

ky826 iT邦新手 5 級 ‧ 2021-03-25 18:43:27 檢舉

再請教一下大大, 如果要以迴圈執行, 即有多個B欄. 又該如何修改呢?
目前的寫法看來只能用在A欄有序號? 讓每筆數據都跟A欄對應嗎?

謝謝

koro_michael iT邦新手 2 級 ‧ 2021-03-25 19:19:39 檢舉

還是給我一個範例比較快

ky826 iT邦新手 5 級 ‧ 2021-03-26 16:01:26 檢舉

5	9	0/NA

1 11 12 13
2 33 34 35
3 22 23 24
4 11 12 13
5 9 10 11
6 16 17 18
7 25 26 27
8 66 67 68
9 8 9 10
10 24 25 26

第一列表示檢查到第幾個<10

謝謝

ky826 iT邦新手 5 級 ‧ 2021-03-26 16:02:58 檢舉

koro_michael iT邦新手 2 級 ‧ 2021-03-27 22:37:23 檢舉

Sub 按鈕1_Click()
    Dim Target As Variant
    
    Target = Array("B", "C", "D")
    
    Dim Index As Long
    
    For Each Item In Target
        Index = 1
        Worksheets(1).Range(Item & "1") = "0"
        
        For Each c In Worksheets(1).Range(Item & ":" & Item).Cells
            If Index > 1 And Len(c.Value) > 0 And c.Value < 10 Then
                Worksheets(1).Range(Item & "1") = Worksheets(1).Range("A" & c.Row).Value
                Exit For
            End If
            
            Index = Index + 1
        Next c
    Next Item
End Sub

需要哪些直接加 Target 就好

koro_michael iT邦新手 2 級 ‧ 2021-03-28 14:03:50 檢舉

如果不想要序號跟A走，把以下程式

Worksheets(1).Range(Item & "1") = Worksheets(1).Range("A" & c.Row).Value

改成

Worksheets(1).Range(Item & "1") = c.Row - 1

ky826 iT邦新手 5 級 ‧ 2021-04-23 06:43:41 檢舉

可用, 謝謝koro_michael

ky826 iT邦新手 5 級 ‧ 2021-04-23 10:42:13 檢舉

抱歉, 再請教一下koro_michael 大, 如果要繼續延伸多欄
Array 只能一直編欄位下去, 如果用Range, 又會偵錯 Worksheets(1).Range(Item & "1") = "0"
小弟新手我還沒想到有沒有更好的辦法?
Thanks a lot.

koro_michael iT邦新手 2 級 ‧ 2021-04-23 14:36:53 檢舉

ky826

Sub 按鈕1_Click()
    Dim Index As Long
    Dim Item As String
    Dim i As Integer
    
    For i = 2 To 100
        Index = 1
        Item = change(i)
        Worksheets(1).Range(Item & "1") = "0"
        
        For Each c In Worksheets(1).Range(Item & ":" & Item).Cells
            If Index > 1 Then
                If Len(c.Value) = 0 Then ' 有個欄位是空就結束迴圈
                    Exit For
                ElseIf c.Value < 10 Then
                    Worksheets(1).Range(Item & "1") = c.Row - 1
                    Exit For
                End If
            End If
            
            Index = Index + 1
        Next c
    Next i
End Sub

Function change(ByVal Num As Integer)
    If Num > 26 Then
        Dim Param1 As Integer
        Dim Param2 As Integer
        
        Param1 = Fix(Num / 26)
        Param2 = Num Mod 26
        
        If Param2 = 0 Then
            Param1 = Param1 - 1
            Param2 = 26
        End If
        
        change = change(Param1) + change(Param2)
    Else
        change = Chr(Num + 64)
    End If
End Function

ky826 iT邦新手 5 級 ‧ 2021-04-26 14:48:48 檢舉

太感謝大大了~

ky826 iT邦新手 5 級 ‧ 2021-04-26 17:20:25 檢舉

抱歉, 如果要再推到每行同時檢出第一個與第二個小於10的位置
需要將這段改成迴圈, 對嗎?
ElseIf c.Value < 10 Then
Worksheets(1).Range(Item & "1") = c.Row - 1

koro_michael iT邦新手 2 級 ‧ 2021-04-26 17:34:52 檢舉

ky826

Sub 按鈕1_Click()
    Dim Index As Long
    Dim Item As String
    Dim i As Integer
    Dim First As Long
    Dim Second As Long
    
    For i = 2 To 100
        Index = 1
        First = 0
        Second = 0
        Item = change(i)
        
        For Each c In Worksheets(1).Range(Item & ":" & Item).Cells
            If Index > 1 Then
                If Len(c.Value) = 0 Then ' 有個欄位是空就結束迴圈
                    Worksheets(1).Range(Item & "1") = CStr(First)
                    Exit For
                ElseIf c.Value < 10 Then
                    If First = 0 Then
                        First = c.Row - 1
                    Else
                        Second = c.Row - 1
                        Worksheets(1).Range(Item & "1") = CStr(First) & "-" CStr(Second)
                        Exit For
                    End If
                End If
            End If
            
            Index = Index + 1
        Next c
    Next i
End Sub

ky826 iT邦新手 5 級 ‧ 2021-04-26 18:06:52 檢舉

嘗試想將First 放第一列 & Second放第二列..... 失敗

ky826 iT邦新手 5 級 ‧ 2021-04-26 18:17:18 檢舉

Oh ya~ 我再想了一下, 試成功了
再次感謝koro_michael

ky826 iT邦新手 5 級 ‧ 2021-04-29 18:48:06 檢舉

抱歉再請教, 如果繼續延伸同欄找第三個&第四個. 又該如何寫?
再度卡關中.....

koro_michael iT邦新手 2 級 ‧ 2021-04-30 10:50:51 檢舉

ky826

Sub 按鈕1_Click()
    Dim Index As Long
    Dim Item As String
    Dim i As Integer
    Const Target As Integer = 3 ' 要找的數量
    
    For i = 2 To 100
        ReDim TargetArr(Target - 1) As Integer
        Dim Counter As Integer
        Counter = 0
        Index = 1
        Item = Change(i)

        For Each c In Worksheets(1).Range(Item & ":" & Item).Cells
            If Index > 1 Then
                If Len(c.Value) = 0 Then ' 有個欄位是空就結束迴圈
                    Worksheets(1).Range(Item & "1") = MakeResult(TargetArr)
                    Exit For
                ElseIf c.Value < 10 Then
                    TargetArr(Counter) = c.Row - 1
                    Counter = Counter + 1
                    
                    If Counter = Target Then
                        Worksheets(1).Range(Item & "1") = MakeResult(TargetArr)
                        Exit For
                    End If
                    
                End If
            End If
            
            Index = Index + 1
        Next c
    Next i
End Sub

Function MakeResult(Arr() As Integer)
    Dim Result As String
    Result = "0"
    
    For Each Item In Arr
        If Item = 0 Then
            Exit For
        End If
        
        If Result = "0" Then
            Result = CStr(Item)
        Else
            Result = Result & "_" & CStr(Item)
        End If
    Next Item
    
    MakeResult = Result
End Function

Function Change(ByVal Num As Integer)
    If Num > 26 Then
        Dim Param1 As Integer
        Dim Param2 As Integer
        
        Param1 = Fix(Num / 26)
        Param2 = Num Mod 26
        
        If Param2 = 0 Then
            Param1 = Param1 - 1
            Param2 = 26
        End If
        
        Change = Change(Param1) & Change(Param2)
    Else
        Change = Chr(Num + 64)
    End If
End Function

ky826 iT邦新手 5 級 ‧ 2021-05-03 18:36:54 檢舉

如果需求項是這樣呢?

koro_michael iT邦新手 2 級 ‧ 2021-05-05 09:41:09 檢舉

ky826

Sub 按鈕1_Click()
    Dim Index As Long
    Dim Item As String
    Dim i As Integer
    Const Target As Integer = 4 ' 要找的數量
    
    For i = 2 To 2
        ReDim TargetArr(Target - 1) As Integer
        Dim Counter As Integer
        Counter = 0
        Index = 1
        Item = Change(i)

        For Each c In Worksheets(1).Range(Item & ":" & Item).Cells
            If Index > 4 Then
                If Len(c.Value) = 0 Then ' 有個欄位是空就結束迴圈
                    Call MakeResult(TargetArr, Item)
                    Exit For
                ElseIf c.Value < 10 Then
                    TargetArr(Counter) = c.Row - 4
                    Counter = Counter + 1
                    
                    If Counter = Target Then
                        Call MakeResult(TargetArr, Item)
                        Exit For
                    End If
                    
                End If
            End If
            
            Index = Index + 1
        Next c
    Next i
End Sub

Sub MakeResult(Arr() As Integer, Column As String)
    Dim i As Integer
    i = 1
    
    For Each Item In Arr
        If Item = 0 Then
            Exit For
        End If
        
        Worksheets(1).Range(Column & CStr(i)) = CStr(Item)
        i = i + 1
    Next Item
End Sub

Function Change(ByVal Num As Integer)
    If Num > 26 Then
        Dim Param1 As Integer
        Dim Param2 As Integer
        
        Param1 = Fix(Num / 26)
        Param2 = Num Mod 26
        
        If Param2 = 0 Then
            Param1 = Param1 - 1
            Param2 = 26
        End If
        
        Change = Change(Param1) & Change(Param2)
    Else
        Change = Chr(Num + 64)
    End If
End Function