Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Сергей Тихомиров
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Цикл For для нескольких строк
 
#
23.11.2022 13:47:52
Все разобрался, вопрос решен. Спасибо
 
Перейти    
Цикл For для нескольких строк
 
#
22.11.2022 14:55:30
Цитата
написал:
Цитата
Сергей Тихомиров написал:
чтобы он работал не только на первую строку,
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27      Private   Sub   CommandButton1_Click()    Dim   m   As   Integer    Dim   x   As   Integer    Dim   out   As   Integer    dim lr as long    for lr = 2 to 10    m = Cells(lr, 1)    x = Cells(lr, 2)    out = Cells(lr, 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(lr, 4) = j    Cells(lr, 5) = j + 1    Cells(lr, 6) = i    Next    End   Sub  
 
Вы правы, в моем вопросе много недочетов, не много голова уже перегружена сегодня. Ваш код, к сожалению, не работает, ругается.  
 
Перейти    
Цикл For для нескольких строк
 
#
22.11.2022 14:23:28
Здравствуйте, сразу к делу: нужно преобразовать данный код, чтобы он работал не только на первую строку, а на диапазон строк. Например до 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
Изменено: Сергей Тихомиров - 22.11.2022 14:27:51
 
Перейти    
Упрощение макроса вставки картинок по критерию
 
#
25.08.2022 14:15:16
No Name, Спасибо
 
Перейти    
Упрощение макроса вставки картинок по критерию
 
#
25.08.2022 10:07:43
Здравствуйте, есть макрос копирования картинок по критерию и централизация картинок в ячейке, который работает, но чем больше строк тем больше нагрузка, соответственно медленнее и тд. Вопрос: Есть ли вариант упрощения или улучшение данного макроса? Подобных строк, как в файле, 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
Изменено: Сергей Тихомиров - 25.08.2022 10:08:12
 
Перейти    
Макрос копирования данных с критериями
 
#
22.08.2022 10:26:45
Александр Макаров, Спасибо огромнейшее, чувствовал, что решение уже где-то близко)  Но т.к. в VBA новичок не понял куда копать  :D
 
Перейти    
Макрос копирования данных с критериями
 
#
22.08.2022 09:47:06
Здравствуйте, стоит задача составить макрос для копирования данных с одного листа по критериям в другой. На просторах интернета нашел похожую, но все равно иную и попытался этот макрос переделать по нужную мне задачу. И вот он вроде бы работает, но криво. Прошу помощи разобраться. Сама задача звучит так:  Нужно чтобы данные с листа 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
 
Перейти    
Страницы: 1
Наверх