помогите пожалуйста, нужно объяснение. есть функция код который :
Код
Function SpecTrim(ByVal SourceString As String, ByVal CharsSet As String) As String
arr = Split(SourceString, ",")
If UBound(arr) > 0 Then
If arr(UBound(arr)) = arr(UBound(arr) - 1) Then arr(UBound(arr)) = ""
Result = Join(arr)
Else
Result = arr(0)
End If
For i = 1 To Len(CharsSet)
Result = Replace(Result, Mid(CharsSet, i, 1), "")
Next i
SpecTrim = Result
End Function
как сделать так, что бы она работала в макросе? к примеру взять значение из ячейки, прогнать его через эту функцию, а результат вставить в другую ячейку (так же где и как задать "не нужные символы"?)
Sub ApplyFunction()
Dim rngSource As Range
Dim Cl As Range
With Worksheets("Лист1")
Set rngSource = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For Each Cl In rngSource.Cells
Cl.Offset(, 1) = SpecTrim(Cl.Value, .Range("C1")) 'ненужные символы в ячейке 'С1'
Next
End With
End Sub
Function SpecTrim(SourceString As String, CharsSet As String) As String
arr = Split(SourceString, ",")
If UBound(arr) > 0 Then
If arr(UBound(arr)) = arr(UBound(arr) - 1) Then arr(UBound(arr)) = ""
Result = Join(arr)
Else
Result = arr(0)
End If
For i = 1 To Len(CharsSet)
Result = Replace(Result, Mid(CharsSet, i, 1), "")
Next i
SpecTrim = Result
End Function
Sub ApplyFunction()
Dim rngSource As Range
Dim Cl As Range
With Worksheets("Лист1")
Set rngSource = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For Each Cl In rngSource.Cells
Cl.Offset(, 1) = SpecTrim(Cl.Value, "*/.() """) 'ненужные символы в самом макросе'
Next
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
Не знаю . Нужно видеть исходные данные и весь макрос Ну а если на вскидку, то не указан лист для ячейки Cells(i, j + 3). Судя по аббревиатуре mwb1 это какая-то книга, а у ячейки родитель это лист
Согласие есть продукт при полном непротивлении сторон
Sub pisec()
Dim ish(3, 15, 10) As String
Dim vig(3, 15, 10) As String
Set mwb = ActiveWorkbook
Set mwbl = mwb.Sheets("1")
Set mwb2 = mwb.Sheets("2")
k = 1
m = 1
ish(k, 0, 0) = mwbl.Cells(1, 1)
For i = 1 To mwbl.Cells(Rows.Count, 1).End(xlUp).Row
If ish(k, 0, 0) = mwbl.Cells(i, 1) Then
For j = 0 To 6
ish(k, m, j) = SpecTrim(mwb1.Cells(i, j + 3), Range("aa1"))
Next j
m = m + 1
GoTo a
ElseIf ish(k, 0, 0) <> mwbl.Cells(i, 1) Then
k = k + 1
m = 1
ish(k, 0, 0) = mwbl.Cells(i, 1)
For j = 0 To 6
ish(k, m, j) = SpecTrim(mwb1.Cells(i, j + 3), Range("aa1"))
Next j
End If
a:
Next i
k = 1
m = 1
vig(k, 0, 0) = mwb2.Cells(1, 1)
For i = 1 To mwb2.Cells(Rows.Count, 1).End(xlUp).Row
If vig(k, 0, 0) = mwb2.Cells(i, 1) Then
For j = 0 To 6
vig(k, m, j) = SpecTrim(mwb2.Cells(i, j + 3), Range("aa1"))
Next j
m = m + 1
GoTo b
ElseIf vig(k, 0, 0) <> mwb2.Cells(i, 1) Then
k = k + 1
m = 1
vig(k, 0, 0) = mwb2.Cells(i, 1)
For j = 0 To 6
vig(k, m, j) = SpecTrim(mwb2.Cells(i, j + 3), Range("aa1"))
Next j
End If
b:
Next i
End Sub
Function SpecTrim(ByVal SourceString As String, ByVal CharsSet As String) As String
arr = Split(SourceString, ",")
If UBound(arr) > 0 Then
If arr(UBound(arr)) = arr(UBound(arr) - 1) Then arr(UBound(arr)) = ""
Result = Join(arr)
Else
Result = arr(0)
End If
For i = 1 To Len(CharsSet)
Result = Replace(Result, Mid(CharsSet, i, 1), "")
Next i
SpecTrim = Result
End Function
изначально макрос копировал инфу из определенных ячеек по определенным условиям в массив, но понадобилось, что бы он копировал туда информацию избавившись от всех лишних знаков ( заданных) то есть брал в себя просто набор символов как в примере ( 1ый пост) вот я и хотел спаять их в едино