Здравствуйте, сразу к делу: нужно преобразовать данный код, чтобы он работал не только на первую строку, а на диапазон строк. Например до 10. Понимаю что скорее всего нужно взять это все в массив и использовать\внедрить For Each, но никак не получается разобраться. Заранее благодарен.
Код
Private Sub CommandButton1_Click()
Dim m As Integer
Dim x As Integer
Dim out As Integer
m = Cells(2, 1)
x = Cells(2, 2)
out = Cells(2, 3)
For i = m To x Step -x
If i > 0 Then
i = i - out
j = j + 1
End If
If I < 0 Then
i = i + out
Exit For
End If
Next i
Cells(2, 4) = j
Cells(2, 5) = j + 1
Cells(2, 6) = i
End Sub
Здравствуйте, есть макрос копирования картинок по критерию и централизация картинок в ячейке, который работает, но чем больше строк тем больше нагрузка, соответственно медленнее и тд. Вопрос: Есть ли вариант упрощения или улучшение данного макроса? Подобных строк, как в файле, 300+
Код
Sub Вставка2()
Dim i&, r As Range, shp As Shape
For i = 4 To 393
Set r = Sheets(2).Cells.Find(Cells(i, 3).Value, LookAt:=xlWhole)
For Each shp In Sheets(2).Shapes
If shp.TopLeftCell.Address = r.Next.Address Then
shp.Copy
Cells(i, 2).PasteSpecial xlPasteAll
End If
Next
Next
Dim sh As Shape, ph#, pw, ch#, cw#, px#, py#
For Each sh In ActiveSheet.Shapes
If sh.Type = msoDiagram Then sh.Select False
ph = sh.Height: pw = sh.Width
ch = sh.TopLeftCell.MergeArea.Height: cw = sh.TopLeftCell.MergeArea.Width
px = sh.TopLeftCell.MergeArea.Left + (cw - pw) / 2
py = sh.TopLeftCell.MergeArea.Top + (ch - ph) / 2
sh.Left = px
sh.Top = py
Next
End Sub
Здравствуйте, стоит задача составить макрос для копирования данных с одного листа по критериям в другой. На просторах интернета нашел похожую, но все равно иную и попытался этот макрос переделать по нужную мне задачу. И вот он вроде бы работает, но криво. Прошу помощи разобраться. Сама задача звучит так: Нужно чтобы данные с листа 2 копировались на лист 1 по критерию в столбце С. Подобных строк в листе 2 будут около 250, а листе 1 зависит от заказа.
Код
Sub Копирование()
AllRecs = Application.WorksheetFunction.CountA(Sheets("1").Range("C:C")) ' Получение количества строк на листе 1 (подсчет значений в столбце B)
cAllRecs = Application.WorksheetFunction.CountA(Sheets("2").Range("B:B")) 'Аналогично для листа 2
For CurRec = 1 To AllRecs
For cRecs = 3 To cAllRecs
If Sheets("1").Cells(CurRec, 3) = Sheets("2").Cells(cRecs, 2) Then 'сверка критериев если Они равны то:
'в этой строке указанным ячейкам присвоить значения из листа 1
Sheets("1").Cells(cRecs, 6) = Sheets("2").Cells(CurRec, 3)
Sheets("1").Cells(cRecs, 7) = Sheets("2").Cells(CurRec, 4)
End If 'конец условия
Next cRecs 'следующая строка на Листе2
'После окончания проверки на Листе 2 возвращаемся на Лист 1 за следующей суммой критериев:
Next CurRec
End Sub