VBA Formula несовпадение

Question

Не могли бы вы помочь с этой строкой кода?

Я пытаюсь достичь формата, показанного на картинке.Я могу сделать это очень хорошо, без VBA.Я хочу, чтобы код подсчитывал количество записей в столбце от B9 до B500.

Для количества записей, если значение <> "", установите ячейку в той же строке в столбце Lравно "= LEFT (B" номер строки ", FIND (" - ", B" номер строки ") - 1)"

Для количества записей, если значение <> "", то установитьячейка в той же строке в столбце M равна "= RIGHT (B" номер строки ", LEN (B" номер строки ") - FIND (" - ", B" номер строки "))"

Answer 1

Используйте разделение текста на столбцы в дефисе в качестве разделителя.

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

Answer 2

'Artist - Название' Колонка?

Формулы 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

Answer 3

Наверное, должно быть что-то вроде этого.Ключ заключается в том, чтобы создать счетчик, который считает успешные элементы и увеличивает его в соответствии с вашей логической оценкой.После этого вы можете использовать функцию «Смещение» или просто добавить ее к значению строки в адресе назначения.

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