Получить данные после знака новой строки Chr(10)


Function GetCompanyNameNew(r As Range) As Variant
s_left = InStr(1, r, Chr(10), vbTextCompare)
s_right = InStr(s_left + 1, r, Chr(10), vbTextCompare)

If s_left = 0 Then
   GetCompanyNameNew = r
Else
   GetCompanyNameNew = Mid(r, 1, s_left - 1)
End If
End Function

Function GetCompanyNameNewRRRRR(r As Range)
  If r = 51 Then
     GetCompanyNameNewRRRRR = GetCompanyNameNew(Range("D" & r.Row))
  Else
     GetCompanyNameNewRRRRR = GetCompanyNameNew(Range("C" & r.Row))
  End If
End Function


'Заполняем данные по контрагентам (оч быстро)
Sub sdsdsdsd()
For i = 6 To Cells.SpecialCells(xlLastCell).Row

 Select Case Range("E" & i).Value
           Case 55.03: Range("J" & i) = "Депозит (размещение) " & Trim(Range("K" & i).Value)
                       GoTo Nexti
           Case 57.02: Range("J" & i) = "Конвертация валюты"
                       GoTo Nexti
           Case 58.03: Range("J" & i) = "Выдача кредита (займа)"
                       GoTo Nexti
           Case 62.01: Range("J" & i) = "Возврат ДС"
                       GoTo Nexti
           Case 68 To 69.99: Range("J" & i) = "Налоги"
                       GoTo Nexti
           Case 70: Range("J" & i) = "Зарплата"
                       GoTo Nexti
           Case 91 To 91.9: Range("J" & i) = "РКО"
                       GoTo Nexti
    End Select
    
        Select Case Range("G" & i).Value
           Case 55.03: Range("J" & i) = "Депозит (изъял) " & Trim(Range("K" & i).Value)
                       GoTo Nexti
           Case 57.02: Range("J" & i) = "Конвертация валюты"
                       GoTo Nexti
           Case 58.03: Range("J" & i) = "Выдача кредита (займа)"
                       GoTo Nexti
           Case 60 To 60.9: Range("J" & i) = "Возврат ДС от поставщика"
                       GoTo Nexti
           Case 66 To 67.9: Range("J" & i) = "Получение кредита от " & Trim(Range("K" & i).Value)
                       GoTo Nexti
           Case 68 To 69.99: Range("J" & i) = "Налоги"
                       GoTo Nexti
           Case 70: Range("J" & i) = "Зарплата"
                       GoTo Nexti
           Case 91 To 91.9: Range("J" & i) = "РКО"
                       GoTo Nexti
         End Select
                       


  If Range("E" & i).Value = 51 Then
     Range("J" & i) = GetCompanyNameNew(Range("D" & i))
  Else
     Range("J" & i) = GetCompanyNameNew(Range("C" & i))
  End If
  
Nexti:
Next i
End Sub


2 Replies to “Получить данные после знака новой строки Chr(10)”

  1.  Function GetCompanyNameNew(r As Range, Optional cn As Integer = 0) As Variant
    s_left = InStr(1, r, Chr(10), vbTextCompare)
    s_right = InStr(s_left + 1, r, Chr(10), vbTextCompare)
     
    's_left2 = InStr(s_right, r, Chr(10), vbTextCompare)
    's_right2 = InStr(s_left2 + 1, r, Chr(10), vbTextCompare)
     
    If s_left = 0 Then GetCompanyNameNew = r
    If cn = 0 Then GetCompanyNameNew = Mid(r, 1, s_left - 1)
    If cn > 1 Then
       GetCompanyNameNew = Mid(r, s_left, s_right - s_left)
    End If
    End Function
  2. Function GetCompanyNameNew(r As Range, Optional cn As Integer = 0) As Variant
    s_left = InStr(1, r, Chr(10), vbTextCompare)
    's_right = InStr(s_left + 1, r, Chr(10), vbTextCompare)
     
    's_left2 = InStr(s_right, r, Chr(10), vbTextCompare)
    's_right2 = InStr(s_left2 + 1, r, Chr(10), vbTextCompare)
     
    If s_left = 0 Then
    GetCompanyNameNew = r
    Exit Function
    End If
    If cn = 0 Or cn = 1 Then
     GetCompanyNameNew = Mid(r, 1, s_left - 1)
    Exit Function
    End If
     
    If cn > 1 Then
    s_right = 1
    For i = 1 To cn
    If i = 1 Then
    s_left = 1
    s_right = InStr(s_left + 1, r, Chr(10), vbTextCompare)
    End If
    If i > 1 And cn = i + 1 Then
      s_left = InStr(s_right, r, Chr(10), vbTextCompare)
      s_right = InStr(s_left + 1, r, Chr(10), vbTextCompare)
        dfdfdfdf = InStr(s_right + 1, r, Chr(10), vbTextCompare)
      GetCompanyNameNew = Mid(r, s_right + 1, dfdfdfdf - s_right - 1)
    Exit Function
    End If
     
    If i = cn - 1 Then
    Debug.Print Mid(r, s_right, InStr(s_right, r, Chr(10), vbTextCompare))
    GetCompanyNameNew = Mid(r, s_right + 1, InStr(s_right, r, Chr(10), vbTextCompare) - 2)
    Exit Function
    End If
     
    Next i
    ' GetCompanyNameNew = Mid(r, s_left, s_right — s_left)
     
    End If
    End Function

Добавить комментарий

Ваш адрес email не будет опубликован.