【问题标题】：VBA Formula mismatchVBA 公式不匹配
【发布时间】：2018-10-27 01:19:34
【问题描述】：

请您帮忙处理这行代码吗？

我正在尝试实现图像中显示的格式。我可以很好地做到这一点，没有 VBA。我希望代码计算从 B9 到 B500 的列中有多少条目。

对于条目数，如果值 ""，则设置L列同一行的单元格等于"=LEFT(B "行号", FIND(" - ",B "行号" )-1)"

对于条目数，如果值“”，则设置M列同一行的单元格等于“=RIGHT(B“行号”,LEN(B“行号”)-FIND( " - ",B "行号"))"

【问题讨论】：

只需查找如何遍历范围并使用 OFFSET 检查不同列中的单元格。我试图输入一个解决方案，但我确定这在手机上是不可能的：0

标签： excel vba

【解决方案1】：

使用连字符上的 Text-to-Columns 拆分作为分隔符。

sub splitHypen()
    with worksheets("sheet1")
        .range(.cells(9, "B"), .cells(9, "B").end(xldown)).TextToColumns _
                Destination:=.cells(9, "L"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
                Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="-", _
                FieldInfo:=Array(Array(1, 1), Array(2, 1))
    end with
end sub

【讨论】：

这行得通，但我很难修改它。我希望我们能找到更接近 Jake 帖子的解决方案。这可能吗？
听到这个消息很难过。我已经注释了 Jakes 解决方案。

【解决方案2】：

应该是这样的。关键是创建一个计数器来计算成功的项目并根据您的逻辑评估增加它。之后，您可以使用 Offset 函数，也可以将其添加到目标地址中的行值中。

dim rwcnt, itemcnt as integer    

itemcnt = 0    '<- This is your counter for each non-blank row
for rwcnt = 9 to 500
    if activesheet.cells(rwcnt,2).value <> "" then
        itemcnt = itemcnt + 1      '<- This increments it BEFORE you start copying information, so if you want to print out how many items there were, etc. 
        activesheet.cells(9,12).offset(itemcnt,0).value = left(activesheet.cells(rwcnt,2).value,instr(1,"-",activesheet.cells(rwcnt,2),vbtextcompare))     '<- This part begins your copying stuff
        activesheet.cells(9,12).offset(itemcnt,1).value = right(activesheet.cells(rwcnt,2).value,len(activesheet.cells(rwcnt,2).value)-instr(1,"-",activesheet.cells(rwcnt,2), vbtextcompare))
    end if
next rwcnt

【讨论】：

这就是我的想法。唯一的问题是该行的“查找”部分会弹出一个错误，说明它未定义。
VBA Find is Instr.

【解决方案3】：

“艺术家 - 标题”列？

Excel 公式应如下所示：

' In Cell L9: =IF(ISERROR(FIND(" - ",B9)),"",LEFT(B9,FIND(" - ",B9)-1))
' In Cell M9: =IF(ISERROR(FIND(" - ",B9)),"",RIGHT(B9,LEN(B9)-FIND(" - ",B9)-LEN(" - ")+1))

至少仔细阅读代码的自定义部分以避免丢失数据。

下一个方法的“经典”

Sub CellsSplitterForNext()
'Description:
  'Separates the delimited contents of cells in a column to new columns.

'Excel Formulas:
' In Cell L9: =IF(ISERROR(FIND(" - ",B9)),"",LEFT(B9,FIND(" - ",B9)-1))
' In Cell M9: =IF(ISERROR(FIND(" - ",B9)),"",RIGHT(B9,LEN(B9)-FIND(" - ",B9)-LEN(" - ")+1))

'**** Customize BEGIN ******************
  Const cStrSource As String = "B" 'Source Column
  Const cStrTarget1 As String = "L" 'Target Column 1
  Const cStrTarget2 As String = "M" 'Target Column 2
  Const cStrSplitter As String = " - " 'Split String
  Const cLngFirst As Long = 9 'First Row
  Const cLngLast As Long = 500 'Last Row(0 to choose last row of data in column)
'**** Customize END ********************

  Dim lng1 As Long 'Row Counter
  Dim lngLast As Long 'Last Row

  'I would rather the code automatically calculate the last row then be tied up
  'to 500 rows, that is, if there is no data below. The same can be done for
  'the first row if it contains the first data in the column. You have to change
  '"cLngLast as Long = 0" in the customize section for this to work.
  If cLngLast = 0 Then
    lngLast = Cells(Rows.Count, cStrSource).End(xlUp).Row
   Else
    lngLast = cLngLast
  End If

  For lng1 = cLngFirst To lngLast
    If InStr(Cells(lng1, cStrSource), cStrSplitter) <> 0 Then
      Cells(lng1, cStrTarget1) = Split(Cells(lng1, cStrSource), cStrSplitter)(0)
      Cells(lng1, cStrTarget2) = Split(Cells(lng1, cStrSource), cStrSplitter)(1)
     Else
      Cells(lng1, cStrTarget1) = ""
      Cells(lng1, cStrTarget2) = ""
    End If
  Next

End Sub

超快速阵列方法

Sub CellsSplitterArray()
'Description:
  'Separates the delimited contents of cells in a column to new columns.

'Excel Formulas:
' In Cell L9: =IF(ISERROR(FIND(" - ",B9)),"",LEFT(B9,FIND(" - ",B9)-1))
' In Cell M9: =IF(ISERROR(FIND(" - ",B9)),"",RIGHT(B9,LEN(B9)-FIND(" - ",B9)-LEN(" - ")+1))

'**** Customize BEGIN ******************
  Const cStrSource As String = "B" 'Source Column
  Const cStrTarget1 As String = "L" 'Target Column 1
  'Note: In this version Target Column 2 has to be the next adjacent column
  'to Target Column 1
  Const cStrTarget2 As String = "M" 'Target Column 2
  Const cStrSplitter As String = " - " 'Split String
  Const cLngFirst As Long = 9 'First Row
  Const cLngLast As Long = 500 'Last Row(0 to choose last row of data in column)
'**** Customize END ********************

  Dim oRng As Range
  Dim arrSource As Variant 'Source Array
  Dim arrTarget As Variant 'Target Array
  Dim int1 As Integer 'Target Array Columns Counter

  Dim lng1 As Long 'Row Counter
  Dim lngLast As Long 'Last Row

  Const c1 As String = "," 'Debug String Column Separator
  Const r1 As String = vbCr 'Debug String Row Separator
  Dim str1 As String 'Debug String Concatenator

  'I would rather the code automatically calculate the last row then be tied up
  'to 500 rows, that is, if there is no data below. The same can be done for
  'the first row if it contains the first data in the column. You have to change
  '"cLngLast as Long = 0" in the customize section for this to work.
  If cLngLast = 0 Then
    lngLast = Cells(Rows.Count, cStrSource).End(xlUp).Row
   Else
    lngLast = cLngLast
  End If

  'Source Range
  Set oRng = Range(Range( _
      Cells(cLngFirst, cStrSource), _
      Cells(lngLast, cStrSource) _
      ).Address)
  'Source Array
  arrSource = oRng

'            str1 = str1 & "*** arrSource Data ***"
'            For lng1 = LBound(arrSource) To UBound(arrSource)
'              str1 = str1 & r1 & arrSource(lng1, 1)
'            Next

  'Target Array
  ReDim arrTarget(LBound(arrSource) To UBound(arrSource), 1 To 2)

  For lng1 = LBound(arrSource) To UBound(arrSource)
    If InStr(arrSource(lng1, 1), cStrSplitter) <> 0 Then
      For int1 = 1 To 2
        arrTarget(lng1, int1) = _
            Split(arrSource(lng1, 1), cStrSplitter)(int1 - 1)
      Next
    End If
  Next

'            str1 = str1 & r1 & "*** arrTarget Data ***"
'            For lng1 = LBound(arrTarget) To UBound(arrTarget)
'              If Not arrTarget(lng1, 1) = "" And Not arrTarget(lng1, 2) = "" Then
'                str1 = str1 & r1 & arrTarget(lng1, 1)
'                str1 = str1 & c1 & arrTarget(lng1, 2)
'               Else
'                str1 = str1 & r1
'              End If
'            Next

  'Target Range
  Set oRng = Range(Range( _
      Cells(cLngFirst, cStrTarget1), _
      Cells(lngLast, cStrTarget2) _
      ).Address)

  oRng = arrTarget

'            Debug.Print str1

End Sub

【讨论】：