добрый день.
помогите разобраться в чем может быть косяк.
Когда я присваиваю диапазону значения массива, вставляется пустота, хотя массив состоит из текстовых элементов, что подтверждается msbox перед началом записи.
В нижеприведенном куске кода я присваиваю диапазону массив. Верхняя граница intersect = 1, т.е диапазон состоит из 1 ячейки.
| Код |
|---|
Range(Cells(i + 1, 1), Cells(i + UBound(intersect, 1), width)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(i + 1, 1), Cells(i + UBound(intersect, 1), 1)).Value = intersect |
intersect был получен ранее в ходе выполнения процедуры arr_intersect , которая объединяет массивы, оставляя уникальные значения. Проверка msbox показывает, что в intersect записаны текстовые значения , и записаны правильно.
| Код |
|---|
intersect = arr_intersect(intersect, sp)
For m = 1 To UBound(intersect, 1)
MsgBox (intersect(m, 1))
Next m
|
Arr_intersect приведена ниже:
| Код |
|---|
Function arr_intersect(arr1() As String, arr2() As String)
Dim arr3() As String
Dim n As Integer, t As Integer, p As Integer
On Error Resume Next
If IsArrayEmpty(arr1) = False Then
If IsArrayEmpty(arr2) = False Then
n = 0
For t = 1 To UBound(arr1, 1)
For j = 1 To UBound(arr2, 1)
If arr1(t, 1) = arr2(j, 1) Then
n = n + 1
End If
Next
Next
ReDim arr3(1 To UBound(arr1, 1) + UBound(arr2, 1) - n, 1 To 1)
For t = 1 To UBound(arr1, 1)
arr3(t, 1) = arr1(t, 1)
Next
p = 0
For j = 1 To UBound(arr2, 1)
n = 0
For t = 1 To UBound(arr1, 1)
If arr2(j, 1) <> arr3(t, 1) Then
n = n + 1
End If
Next
If n = UBound(arr1) Then
p = p + 1
arr3(UBound(arr1, 1) + p, 1) = arr2(j, 1) 'записываем в конец новый элемент
End If
Next
arr_intersect = arr3
Else
arr_intersect = arr1
End If
Else
If IsArrayEmpty(arr2) = False Then
arr_intersect = arr2
End If
End If
End Function
|
Проверка If IsArrayEmpty массива на пустоту , вроде была заимствована у ZVI.
| Код |
|---|
Function IsArrayEmpty(x) As Boolean
Dim i&
On Error Resume Next
i = LBound(x, 1)
IsArrayEmpty = Err <> 0
End Function
|
массив sp получался в результате обработки листа и получения списка значений в виде двумерного массива. В конкретном случае, он содержит 1 значение - слово.
| Код |
|---|
sp = ToInsert(kod, mas(1, k), mas(2, k)) |
| Код |
|---|
Function ToInsert(ByVal kod As String, ByVal name As String, ByVal bl_r As Integer) ', list1 As Worksheet)
Dim intersect() As String, sp() As String
Worksheets(name).Activate
With ActiveSheet
i = bl_r
For i = bl_r To 6 Step -1
j = 0
If Cells(i, 2) = kod Then
Do While Cells(i + 1 + j, 2) = ""
j = j + 1
Loop
If j > 0 Then
ReDim sp(1 To j, 1)
For k = 1 To UBound(sp, 1)
sp(k, 1) = Cells(i + k, 1).Value
Next
End If
End If
Next
If IsArrayEmpty(sp) = True Then
Erase sp
ToInsert = sp
Else
ToInsert = sp
End If
End With
End Function |
Суть этой части программы в том, что по циклу пробегаем нужные листы, далее если в указанном столбце находим код, то берем в список sp значения из нижележащих ячеек соседнего столбца, у которых кода нет. Затем объединяем sp и intersect (изначально пустой), переходим на следующий лист, опять заполняем sp, опять пересекаем и т.д. Затем в рабочем листе вставляем где нужно число строк соответствующее ubound(intersect,1) и значения intersect вставляется в ячейки. У меня строки добавляются, число строк правильное, но почему то диапазон заливается пустотой. Help.
