複製在不同的列是什麼偶數和奇數分離經 「：」

Question

我有如下代碼：A106：A107：A110：A111：A112：A113：A118：A119

我想獲得一個在兩個不同的列中回答：即使和奇數。

實施例：A106：A110：A112：A118和A107：A111：A113：A119。

有人能給我一個自動操作的提示嗎？

Answer 1

試試這個VBA函數：

Public Function ExtractOdds(Data As String, Delimiter As String, IsOdd As Boolean) As String 
    Dim Elements() As String 
    Dim Result As String 

    Elements = Split(Data, Delimiter) 

    For Each Item In Elements 
     If Right(Item, 1) Mod 2 = -IsOdd Then 
      If Len(Result) > 0 Then 
       Result = Result & Delimiter 
      End If 
      Result = Result & Item 
     End If 
    Next Item 

    ExtractOdds = Result 
End Function 

使用提取奇數值：

=ExtractOdds(A1,":",TRUE) 

使用提取偶數值：

=ExtractOdds(A1,":",FALSE) 

Answer 2

這將做到這一點：

Sub Test() 
Dim sPart, sFull As String 
Dim WS1, WS2 As Worksheet 
Dim i As Long 

Set WS1 = ActiveSheet 
sFull = "A106:A107:A110:A111:A112:A113:A118:A119" 
Sheets.Add After:=Sheets(Sheets.Count) 
Set WS2 = ActiveSheet 

WS2.Range("A1").Value = "Odd" 
WS2.Range("B1").Value = "Even" 

Do While InStr(sFull, ":") 
    sPart = Left(sFull, InStr(sFull, ":")) 
    i = Mid(sPart, 2, Len(sPart) - 2) 
    If i Mod 2 <> 0 Then 
     WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1) 
     Else 
     WS2.Range("B" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1) 
    End If 
    sFull = Right(sFull, Len(sFull) - Len(sPart)) 
Loop 

sPart = sFull 
i = Mid(sPart, 2, Len(sPart) - 1) 
If i Mod 2 <> 0 Then 
    WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1) 
    Else 
    WS2.Range("B" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1) 
End If 

End Sub