Question

我需要为超过1000个单元格执行此操作，以读取特定数据并使用Excel VBA放入相应的单元格下。

示例：

Name  Age  No. .. .
abc   14   123454    ------>this from single cell

其中包含Name: abc,Age: 14, No: 123454

Answer 1

这应该是一个好的开始：

Sub Split_N_Copy()
Dim InFo()
Dim InfSplit() As String

InFo = ActiveSheet.Cells.UsedRange.Value2
Sheets.Add after:=Sheets(Sheets.Count)

For i = LBound(InFo, 1) To UBound(InFo, 1)
    'Here I put InFo(i,1), "1" if we take the first column
    InfSplit = Split(InFo(i,1), ",")
    For k = LBound(InfSplit) To UBound(InfSplit)
        Sheets(Sheets.Count).Cells(i + 1, k + 1) = InfSplit(k)
    Next k    
Next i

End Sub

Answer 2

我为,编写了一个基于分隔符号的函数，:编写了一个等号的函数，用于搜索第一行包含标题的数据范围：

Function UpdateSheet(allData As String, inRange As Range)

    Dim strData() As String
    Dim i As Long, lastRow As Long
    Dim columnName As String, value As String
    Dim cell As Range

    'You need to change this to finding last row like this answer:
    'http://stackoverflow.com/a/15375099/4519059
    lastRow = 2   

    strData = Split(allData, ",")

    For i = LBound(strData) To UBound(strData)
        columnName = Trim(Left(strData(i), InStr(1, strData(i), ":") - 1))
        value = Trim(Mid(strData(i), InStr(1, strData(i), ":") + 1))

        For Each cell In inRange
            If cell.Cells(1, 1).Rows(1).Row = 1 Then
                If cell.Cells(1, 1).value Like "*" & columnName & "*" Then
                    inRange.Worksheet.Cells(lastRow, cell.Columns(1).Column).value = value
                End If
            End If
        Next
    Next

End Function

现在您可以使用这样的功能：

Sub update()

    Call UpdateSheet("Name: abc,Age: 14, No: 123454", Sheets(1).UsedRange)

End Sub

Answer 3

Private Sub CommandButton1_Click()
lastRow = Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row
Dim i As Integer
i = 2

For i = 2 To lastRow

    Dim GetData As String
    GetData = Sheet1.Cells(i, 7)

    Call UpdateSheet(GetData, Sheets(1).UsedRange, i)

Next

End Sub

Function UpdateSheet(allData As String, inRange As Range, rowno As Integer)

    Dim strData() As String
    Dim i As Long, lastRow As Long
    Dim columnName As String, value As String
    Dim cell As Range

    strData = Split(allData, ",")

    For i = LBound(strData) To UBound(strData)

        Value1 = Trim(Mid(strData(i), InStr(1, strData(i), ":") + 1))

        If Value1 <> "" Then

            columnName = Trim(Left(strData(i), InStr(1, strData(i), ":") - 1))
            value = Trim(Mid(strData(i), InStr(1, strData(i), ":") + 1))

            For Each cell In inRange
                If cell.Cells(1, 1).Rows(1).Row = 1 Then
                    If cell.Cells(1, 1).value Like "*" & columnName & "*" Then
                        inRange.Worksheet.Cells(rowno, cell.Columns(1).Column).value = value
                    End If
                End If
            Next

        End If

    Next

End Function

如何从单个单元格中获取特定值并将其放入Excel VBA

3 个答案: