用VBA数组提取相同姓名连续天数

laoau128

用VBA数组提取相同姓名连续天数

xiangbaoan

Sub test()
Dim Arr, Brr$(), st$, r&, c%, cc%, k%, m&, n%
[k2:n1000] = ""
Arr = [a1].CurrentRegion.Resize(, 12)
ReDim Brr(1 To UBound(Arr), 1 To 4)
For r = 3 To UBound(Arr)
    k = 0
    For c = 2 To 8 Step 2
       k = k + IIf(Arr(r, c) = Arr(r, c + 2), 1, 0)
    Next
    If k > 0 Then m = m + 1
    For c = 2 To 11 Step 2
        st = Arr(r, c)
        n = 0
        If Arr(r, c) = Arr(r, c + 2) Then
            For cc = 2 To 10 Step 2
                n = n + IIf(Arr(r, cc) = st, 1, 0)
            Next
        End If
        If n > 1 Then Brr(m, n - 1) = st
    Next
Next
[k2].Resize(m, 4) = Brr
End Sub'再改了一下，试试行不行?   哎，还是不中……

laoau128

xiangbaoan 发表于 2017-3-23 12:05
Sub test()
Dim Arr, Brr$(), st$, r&, c%, cc%, k%, m&, n%
[k2:n1000] = ""

暂时没有分明天再加

VBA先固定A列   再用5个数字组合输出B列

http://club.excelhome.net/thread-1335872-1-1.html

xiangbaoan

laoau128 发表于 2017-3-23 13:36
暂时没有分明天再加

VBA先固定A列   再用5个数字组合输出B列

Sub test()
Dim Arr, Brr$(), st$, r&, c%, k%, m&, n%
[k2:n6666] = ""
Arr = [a1].CurrentRegion.Resize(, 10)
ReDim Brr(1 To UBound(Arr), 1 To 4)
For r = 3 To UBound(Arr)
    k = 0
    For c = 2 To 8 Step 2
       k = k + IIf(Arr(r, c) = Arr(r, c + 2), 1, 0)
    Next
    If k > 0 Then
        m = m + 1
        n = 0
        For c = 2 To 8 Step 2
            If Arr(r, c) = Arr(r, c + 2) Then n = n + 1: st = Arr(r, c)
        Next
        If Arr(r, 2) = Arr(r, 4) And Arr(r, 8) = Arr(r, 10) And Arr(r, 4) <> Arr(r, 6) Then n = n - 1
        Brr(m, n) = st
    End If
Next
[k2].Resize(m, 4) = Brr
End Sub '第3次更改了，不知如何，没招了

laoau128

xiangbaoan 发表于 2017-3-23 13:45
Sub test()
Dim Arr, Brr$(), st$, r&, c%, k%, m&, n%
[k2:n6666] = ""

我也不知道

laoau128

xiangbaoan 发表于 2017-3-23 12:05
Sub test()
Dim Arr, Brr$(), st$, r&, c%, cc%, k%, m&, n%
[k2:n1000] = ""

用VBA数组查找按下面两种情况改写

http://club.excelhome.net/thread-1336382-1-1.html

xiangbaoan

laoau128 发表于 2017-3-25 21:44
用VBA数组查找按下面两种情况改写

http://club.excelhome.net/thread-1336382-1-1.html

Sub A列没有重复数字和A列只有一个最接近99数字()
Dim Arr, r%, n%
Arr = Range("a1").CurrentRegion.Resize(, 2)
For r = 1 To UBound(Arr)
    Arr(r, 2) = Abs(Arr(r, 1) - 99)
Next
n = Application.Min(Application.Index(Arr, 0, 2))
For r = 1 To UBound(Arr)
   If Arr(r, 2) = n Then MsgBox "最接近99的数是：" & Arr(r, 1) & "。" & vbCrLf & "单元格地址为：A" & r
Next
End Sub