[已解决]用VBA数组提取相同姓名连续天数

laoau138

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

最佳答案

月排行榜 / 总排行榜

wenzili

2017-3-24 14:04

Public Sub master()
Dim sAlldata As Variant
Dim iRow As Integer, iCol As Integer
Dim sName As String
Dim aName As Variant
Dim iaCount() As Integer
Dim i As Integer




sName = "初始"

sAlldata = Range("a3", Cells(3, 10).End(xlDown))
For iRow = 1 To UBound(sAlldata, 1)
    For iCol = 2 To UBound(sAlldata, 2) Step 2
        If sName = "初始" Then
            sName = sAlldata(iRow, iCol)
        Else
            If Not IsEmpty(sAlldata(iRow, iCol)) Then
                If InStr(sName, sAlldata(iRow, iCol)) = 0 Then
                    sName = sName & "-" & sAlldata(iRow, iCol)
                End If
            End If
        End If
    Next
Next
aName = Split(sName, "-")
ReDim iaCount(UBound(aName))
For i = 0 To UBound(aName)
    For iRow = 1 To UBound(sAlldata, 1)
        For iCol = 2 To UBound(sAlldata, 2) Step 2
            If aName(i) = sAlldata(iRow, iCol) Then
                iaCount(i) = iaCount(i) + 1
            End If
        Next
    Next
Next

For i = 0 To UBound(aName)
    sName = aName(i)
    Select Case iaCount(i)
        Case 2
            putdata 11, sName
        Case 3
            putdata 12, sName
        Case 4
            putdata 13, sName
        Case 5
            putdata 14, sName
    End Select
Next
               
End Sub

Public Function putdata(iCol As Integer, sName As String)
Cells(1048576, iCol).End(xlUp).Offset(1, 0).Value = sName

End Function
不考虑重名。
感觉这个算法很笨，应该有更好的算法。

跳转到最佳答案楼层

laoau138

谁会做此题目

wenzili

Public Sub master()
Dim sAlldata As Variant
Dim iRow As Integer, iCol As Integer
Dim sName As String
Dim aName As Variant
Dim iaCount() As Integer
Dim i As Integer




sName = "初始"

sAlldata = Range("a3", Cells(3, 10).End(xlDown))
For iRow = 1 To UBound(sAlldata, 1)
    For iCol = 2 To UBound(sAlldata, 2) Step 2
        If sName = "初始" Then
            sName = sAlldata(iRow, iCol)
        Else
            If Not IsEmpty(sAlldata(iRow, iCol)) Then
                If InStr(sName, sAlldata(iRow, iCol)) = 0 Then
                    sName = sName & "-" & sAlldata(iRow, iCol)
                End If
            End If
        End If
    Next
Next
aName = Split(sName, "-")
ReDim iaCount(UBound(aName))
For i = 0 To UBound(aName)
    For iRow = 1 To UBound(sAlldata, 1)
        For iCol = 2 To UBound(sAlldata, 2) Step 2
            If aName(i) = sAlldata(iRow, iCol) Then
                iaCount(i) = iaCount(i) + 1
            End If
        Next
    Next
Next

For i = 0 To UBound(aName)
    sName = aName(i)
    Select Case iaCount(i)
        Case 2
            putdata 11, sName
        Case 3
            putdata 12, sName
        Case 4
            putdata 13, sName
        Case 5
            putdata 14, sName
    End Select
Next
               
End Sub

Public Function putdata(iCol As Integer, sName As String)
Cells(1048576, iCol).End(xlUp).Offset(1, 0).Value = sName

End Function
不考虑重名。
感觉这个算法很笨，应该有更好的算法。

laoau138

wenzili 发表于 2017-3-24 14:04
Public Sub master()
Dim sAlldata As Variant
Dim iRow As Integer, iCol As Integer

你一个高手了