VBA中的左函数

我通过power shell生成了一个输出文件，该文件提供了一个共享转储，并且具有以下格式的权限：

我希望在VBA中编写一个模块，在该模块中，我可以将原始数据放在一个名为Input和fun the marco的表格中，因此输出如下所示：

我对VBA非常陌生，但修改了Stackoverflow社区提供的一些代码，我已经做到了这一点：

Sub PathAccessSplit()

Dim wsFrom, wsTo As Worksheet
Dim rowFrom, rowTo, lastRow As Long
Dim cellVal As String

Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")

lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
rowTo = 1

For rowFrom = 1 To lastRow
cellVal = wsFrom.Cells(rowFrom, 1).Text

If (Left(cellVal, 4) = "Name") Then
  wsTo.Cells(rowTo, 1).Value = cellVal
ElseIf (Left(cellVal, 8) = "FullName") Then
  wsTo.Cells(rowTo, 2).Value = cellVal
ElseIf (Left(cellVal, 18) = "InheritanceEnabled") Then
  wsTo.Cells(rowTo, 3).Value = cellVal
ElseIf (Left(cellVal, 13) = "InheritedFrom") Then
  wsTo.Cells(rowTo, 4).Value = cellVal
ElseIf (Left(cellVal, 17) = "AccessControlType") Then
  wsTo.Cells(rowTo, 5).Value = cellVal
ElseIf (Left(cellVal, 12) = "AccessRights") Then
  wsTo.Cells(rowTo, 6).Value = cellVal
ElseIf (Left(cellVal, 7) = "Account") Then
  wsTo.Cells(rowTo, 7).Value = cellVal
ElseIf (Left(cellVal, 16) = "InheritanceFlags") Then
  wsTo.Cells(rowTo, 8).Value = cellVal
ElseIf (Left(cellVal, 11) = "IsInherited") Then
  wsTo.Cells(rowTo, 9).Value = cellVal
ElseIf (Left(cellVal, 16) = "PropagationFlags") Then
  wsTo.Cells(rowTo, 10).Value = cellVal
ElseIf (Left(cellVal, 11) = "AccountType") Then
  wsTo.Cells(rowTo, 11).Value = cellVal

  rowTo = rowTo + 1
End If

但是输出只是转置输出，只输出一组结果，而不移动第二组权限

我需要VBA足够健壮，能够处理1000多组输出

任何帮助都将不胜感激

---

韦恩

这与你的

If…Else

结构有关。因为您使用的是

ElseIf

，所以实际上只会运行其中一条语句

您需要更改语法，使其仅在以下语句中使用：

If (Left(cellVal, 4) = "Name") Then
  wsTo.Cells(rowTo, 1).Value = cellVal
End If
If (Left(cellVal, 8) = "FullName") Then
  wsTo.Cells(rowTo, 2).Value = cellVal
End If
If (Left(cellVal, 18) = "InheritanceEnabled") Then
  wsTo.Cells(rowTo, 3).Value = cellVal
End If

等

这样，将测试并运行每个语句（如果它们通过

if

语句中的子句）

要仅选择冒号“：”后的字符，请尝试：

If (Left(cellVal, 4) = "Name") Then 
    wsTo.Cells(rowTo, 1).Value = Right(cellVal, Len(cellVal) - InStr(cellVal, ":") - 1) 
End If

---

这与你的

If…Else

结构有关。因为您使用的是

ElseIf

，所以实际上只会运行其中一条语句

您需要更改语法，使其仅在以下语句中使用：

If (Left(cellVal, 4) = "Name") Then
  wsTo.Cells(rowTo, 1).Value = cellVal
End If
If (Left(cellVal, 8) = "FullName") Then
  wsTo.Cells(rowTo, 2).Value = cellVal
End If
If (Left(cellVal, 18) = "InheritanceEnabled") Then
  wsTo.Cells(rowTo, 3).Value = cellVal
End If

等

这样，将测试并运行每个语句（如果它们通过

if

语句中的子句）

要仅选择冒号“：”后的字符，请尝试：

If (Left(cellVal, 4) = "Name") Then 
    wsTo.Cells(rowTo, 1).Value = Right(cellVal, Len(cellVal) - InStr(cellVal, ":") - 1) 
End If

可以开始分割和修剪单元格信息。批量操作几乎总是比循环更快，并且通常提供更好的错误控制。分割和修剪后，通过变量数组循环到变量数组中，应将值转换到各自的字段中。没有关于保证完整记录集的讨论，所以我避免了简单地将转置的数据全部转储回去

这在很大程度上是未经测试的，因为我不打算重新键入示例数据。如果字段丢失，则可能拼写错误。

可以开始拆分和修剪单元格信息。批量操作几乎总是比循环更快，并且通常提供更好的错误控制。分割和修剪后，通过变量数组循环到变量数组中，应将值转换到各自的字段中。没有关于保证完整记录集的讨论，所以我避免了简单地将转置的数据全部转储回去

---

这在很大程度上是未经测试的，因为我不打算重新键入示例数据。如果字段缺失，则很可能拼写错误。

而不是使用所有这些“如果，那么”我将使用选择的情况， 这是另一种方式

Sub wsfrom_Pulsante1_Click()
Dim wsFrom  As Worksheet, wsTo As Worksheet             'otherwise the first is a variable
Dim rowFrom As Long, rowTo As Long, lastRow As Long
Dim cellVal As String
Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")
lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
rowTo = 1
For rowFrom = 1 To lastRow
cellVal = wsFrom.Cells(rowFrom, 1).text
If cellVal = "" Then    'the blanck row between one block to another
    rowTo = rowTo + 1   'ad 1 for the next row in wsTo
End If
On Error Resume Next    'jump the error Left(cellVal, InStr(cellVal, " ") - 1) because the cell is ""
Select Case Left(cellVal, InStr(cellVal, " ") - 1)
    Case "Name"
        wsTo.Cells(rowTo, 1).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "FullName"
        wsTo.Cells(rowTo, 2).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritanceEnabled"
        wsTo.Cells(rowTo, 3).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritedFrom"
        wsTo.Cells(rowTo, 4).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccessControlType"
        wsTo.Cells(rowTo, 5).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccessRights"
        wsTo.Cells(rowTo, 6).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "Account"
        wsTo.Cells(rowTo, 7).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritanceFlags"
        wsTo.Cells(rowTo, 8).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "IsInherited"
        wsTo.Cells(rowTo, 9).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "PropagationFlags"
        wsTo.Cells(rowTo, 10).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccountType"
        wsTo.Cells(rowTo, 11).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
End Select
Next rowFrom
End Sub

---

而不是使用所有这些“如果，那么”我会使用一个选择的案例， 这是另一种方式

Sub wsfrom_Pulsante1_Click()
Dim wsFrom  As Worksheet, wsTo As Worksheet             'otherwise the first is a variable
Dim rowFrom As Long, rowTo As Long, lastRow As Long
Dim cellVal As String
Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")
lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
rowTo = 1
For rowFrom = 1 To lastRow
cellVal = wsFrom.Cells(rowFrom, 1).text
If cellVal = "" Then    'the blanck row between one block to another
    rowTo = rowTo + 1   'ad 1 for the next row in wsTo
End If
On Error Resume Next    'jump the error Left(cellVal, InStr(cellVal, " ") - 1) because the cell is ""
Select Case Left(cellVal, InStr(cellVal, " ") - 1)
    Case "Name"
        wsTo.Cells(rowTo, 1).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "FullName"
        wsTo.Cells(rowTo, 2).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritanceEnabled"
        wsTo.Cells(rowTo, 3).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritedFrom"
        wsTo.Cells(rowTo, 4).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccessControlType"
        wsTo.Cells(rowTo, 5).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccessRights"
        wsTo.Cells(rowTo, 6).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "Account"
        wsTo.Cells(rowTo, 7).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritanceFlags"
        wsTo.Cells(rowTo, 8).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "IsInherited"
        wsTo.Cells(rowTo, 9).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "PropagationFlags"
        wsTo.Cells(rowTo, 10).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccountType"
        wsTo.Cells(rowTo, 11).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
End Select
Next rowFrom
End Sub

---

这里还有

TextToColumn

，然后使用

rangeAreas

进行复制和粘贴

   Sub Button1_Click()
    Dim RangeArea As Range
    Dim ws As Worksheet, sh As Worksheet

    Set ws = Sheets("Input")
    Set sh = Sheets("Output")

    Application.DisplayAlerts = 0
    Application.ScreenUpdating = 0

    With ws

        .Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                      Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                                                                                                 :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

        .Range(.Range("A1"), .Range("A1").End(xlDown)).Copy
        sh.Range("A1").PasteSpecial xlPasteValues, Transpose:=True

        For Each RangeArea In .Columns("A").SpecialCells(xlCellTypeConstants, 23).Areas

            RangeArea.Offset(, 1).Copy
            sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True

        Next RangeArea

    End With

    Application.CutCopyMode = 0
End Sub

---

这里还有

TextToColumn

，然后使用

rangeAreas

进行复制和粘贴

   Sub Button1_Click()
    Dim RangeArea As Range
    Dim ws As Worksheet, sh As Worksheet

    Set ws = Sheets("Input")
    Set sh = Sheets("Output")

    Application.DisplayAlerts = 0
    Application.ScreenUpdating = 0

    With ws

        .Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                      Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                                                                                                 :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

        .Range(.Range("A1"), .Range("A1").End(xlDown)).Copy
        sh.Range("A1").PasteSpecial xlPasteValues, Transpose:=True

        For Each RangeArea In .Columns("A").SpecialCells(xlCellTypeConstants, 23).Areas

            RangeArea.Offset(, 1).Copy
            sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True

        Next RangeArea

    End With

    Application.CutCopyMode = 0
End Sub

---

问题已经回答了,， 但午饭后我想：如果真的块可以是千块，为什么不使用一个阵列，我用300块广告测试它，速度非常快

Sub wsfrom_Pulsante2_Click()
Dim wsFrom  As Worksheet, wsTo As Worksheet
Dim lastRow As Long
Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")
lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
lastBlock = Round((lastRow + 1) / 12, 0)    'to count how many block (11 item + 1 blanck row) are in the range

Dim arr As Variant
ReDim arr(1 To lastBlock, 1 To 11)          'redim 1th diemnsion array to exactly no off block
i = 1
For x = 1 To lastBlock
        For y = 1 To 11
            arr(x, y) = Mid(Cells(i, 1), (InStr(Cells(i, 1), ":") + 1))
            i = i + 1
        Next y
        i = i + 1                           'add one to jump blanck row
Next x
wsTo.Range("A2:K" & lastBlock) = arr        'put the value on defined sheet
End Sub

---

问题已经回答了,， 但午饭后我想：如果真的块可以是千块，为什么不使用一个阵列，我用300块广告测试它，速度非常快

Sub wsfrom_Pulsante2_Click()
Dim wsFrom  As Worksheet, wsTo As Worksheet
Dim lastRow As Long
Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")
lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
lastBlock = Round((lastRow + 1) / 12, 0)    'to count how many block (11 item + 1 blanck row) are in the range

Dim arr As Variant
ReDim arr(1 To lastBlock, 1 To 11)          'redim 1th diemnsion array to exactly no off block
i = 1
For x = 1 To lastBlock
        For y = 1 To 11
            arr(x, y) = Mid(Cells(i, 1), (InStr(Cells(i, 1), ":") + 1))
            i = i + 1
        Next y
        i = i + 1                           'add one to jump blanck row
Next x
wsTo.Range("A2:K" & lastBlock) = arr        'put the value on defined sheet
End Sub

---

---

奇妙的是，这是有道理的，有没有一种方法可以改变输出，只报告以下信息：？因此，输入是“名称：2002年旅行政策”，但我希望输出是：“2002年旅行政策”谢谢在主要回答中添加了对这一点的响应。这很有意义，有没有办法改变输出，只在以下内容后报告信息：？所以输入是“Name:2002 Travel Policy”，但我希望输出是：“2002 Travel Policy”谢谢在主要答案中添加了对此的响应您真的希望在InheritedFrom的Y上使用尾随冒号吗：？不，这不是必需的，是否可以更轻松地将数据拆分为所需的输出？是否可以将输出移动到输出表中的行？您是否可以控制PowerShell中的输出脚本？如果只在PowerShell中使用

Export CSV

，这将非常容易。从外观上看，您刚刚使用了

Out File

或类似的东西。您好，Matt，是否只需要在powershell中的命令末尾添加导出CSV？因为我对正在运行的命令和脚本有完整的作用域。您真的想在InheritedFrom的Y:上使用尾随冒号吗？不，这不是必需的，这样可以更容易地将数据拆分为我所需的输出吗？如果输出表中的输出被移动到行，您可以控制PowerShell中的输出脚本吗？如果只在PowerShell中使用

Export CSV

，这将非常容易。从外观上看，您刚刚使用了

Out File

或类似的东西。您好，Matt，是否只需要在powershell中的命令末尾添加导出CSV？因为我对正在运行的命令和脚本有完全的控制权。@Jeeped，抱歉，我写的时候有post you，使用一个arry是更好的方式。@Jeeped，抱歉，我写的时候有post you，使用一个arry是更好的方式。经过编辑，所以需要时只显示标题，因此，只有标题出现在主持人面前：评估帖子是否必须放入C.R.，谢谢主持人：评估帖子是否必须放入C.R.，谢谢