Привет всем. Всю голову сломал как назвать тему, так как не знаю названия функции которую хочу увидеть. Простым языком: Есть вот такой файл "1111" Из него нужно сделать файл "2222" Долгим путем я уже делать его научился. Как это сделать быстро? формулой или прием какой может есть? Заранее спасибо
Вложил файл эксель для примера. Первая вкладка как я этот файл получаю, вторая вкладка - как мне этот файл нужно отправить. как бы быстро его превратить из первого во второй)
Sub baurin()
Dim arr(), i&, x&
Application.ScreenUpdating = False
Range([B1], [B1].SpecialCells(xlLastCell)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
arr = [A1].CurrentRegion.Value
ReDim c(1 To UBound(arr) * 2, 1 To 2)
For i = 1 To UBound(arr)
If Not IsEmpty(arr(i, 2)) Then
x = x + 1
c(x, 1) = arr(i, 1)
c(x, 2) = arr(i, 2)
End If
Next
For i = UBound(arr) + 1 To UBound(arr) * 2
If Not IsEmpty(arr(i - UBound(arr), 3)) Then
x = x + 1
c(x, 1) = arr(i - UBound(arr), 1)
c(x, 2) = arr(i - UBound(arr), 3)
End If
Next
[A1].CurrentRegion.Clear
[A1].Resize(x, 2).Value = c
With Range("A1:B" & x)
.RowHeight = 15
.BorderAround xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
End Sub
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
Владимир, ого!!! круто. говорил мне папа "иди на програмиста учись") а если усложню задачу? может вообще можно делать всю задачу с помощью макроса? усложнил первый лист, прикладываю. если сильно обнаглел - извините)
Dim arr(), i&, j&, x&
Application.ScreenUpdating = False
arr = [A1].CurrentRegion.Value
ReDim c(1 To UBound(arr) * 2, 1 To 2)
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
If arr(i, j) = 1 Then
x = x + 1
c(x, 1) = arr(i, 1)
c(x, 2) = arr(1, j): Exit For
End If
Next j
Next
For i = UBound(arr) + 1 To UBound(arr) * 2
For j = UBound(arr, 2) To 2 Step -1
If arr(i - UBound(arr), j) = 1 Then
x = x + 1
c(x, 1) = arr(i - UBound(arr), 1)
c(x, 2) = arr(1, j): Exit For
End If
Next j
Next
Sheets(2).[A1].CurrentRegion.Clear
Sheets(2).[A1].Resize(x, 2).Value = c()
With Sheets(2).Range("A1:B" & x)
.RowHeight = 18
.BorderAround xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
End Sub
У Вас в рабочем файле точно единицы?
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
Владимир,Выходит он берет только две еденички в строке, не более. К примеру в третей строке есть 4 еденички, а во втором листе показывает только 2 позиции. а должен 4.