Страницы: 1
RSS
Вывести список номеров товаров, где есть примечания, вывести список по отношению к нумерации товаров по столбцу G
 
Здравствуйте, уважаемый GRIM уже написал макрос такого вида, в нём выводиться список с нумерацией строк, а хотелось продолжить тему и сделать список по номерам товаров, в прилагаемом файле я расписал что-к -чему, прошу посодействовать в решении проблемы!
Код
Dim Nachalo As Long, lngKonec As Long
    Dim i As Long, x
    Nachalo = НачалоДанных
    lngKonec = КонецДанных
    On Error Resume Next
    For Each cell In Range(Cells(Nachalo - 1, "F"), Cells(lngKonec, "F"))
        If cell.Comment Is Nothing Then
        Else
            x = x & cell.row & ", "
        End If
    Next
    On Error Resume Next
    x = Left(x, Len(x) - 2)
    If x <> "" Then
    MsgBox "Есть проблемы по письмам, ТОВАРЫ № " & x
    Else
    MsgBox "По письмам замечаний нет!"
    End If
 
Код
x = x & Cells(cell.Row, "G") & ", "
 
Kuzmich, в том то и дело , что номера товаров не всегда находятся напротив примечаний...там смещение вниз происходит, если позиций в товаре >1
еслибы вот здесь: Cells(cell.row, "G" ) делало бы так: если напротив пусто в G, то спускаемся вниз до первой непустой ячейки, тогда будет четко номер товара.
Изменено: Домкрат - 16.10.2019 15:55:27
 
Цитата
если напротив пусто в G, то спускаемся вниз до первой непустой ячейки, тогда будет четко номер товара.
Во-первых у вас там не пусто, а пробел
Во-вторых тогда получится в x
"1, 5, 5, 20, 20, 20, 20, "
 
уникальные , конечно нужны значения.
 
Надо переделывать цикл по cell
 
Kuzmich, я знаю только The End))
 
Возможно так:
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Range("F1:F100")
        If cell.Comment Is Nothing Then
            GoTo n
        Else
            If cell.Offset(1, 0) = "" And cell.Offset(0, 1) <> " " Then
                x = x & cell.Offset(0, 1) & ", "
            Else
                If cell.Offset(1, 0) <> "" And cell.Offset(0, 1) = " " Then
                    GoTo n
                Else
                    x = x & cell.Offset(1, 1) & ", "
        End If
            End If
                End If
n:
    Next
    x = Left(x, Len(x) - 2)
    MsgBox "Номера товаров с примечаниями: " & x
End If
End Sub
 
GRIM, супер! огромное спасибо! я, только переделал под запуск просто макросов, а не активацией ячейки.
 
GRIM, не подскажете часть кода вот этого что выполняет? только запятую сцепляет, или ещё что-то?
Код
& ", "
 
В строке
Код
x = x & cell.Offset(1, 1) & ", "

в переменной x записываются номера через запятую с пробелом
В строке
Код
x = Left(x, Len(x) - 2)

убирается последняя запятая с пробелом
 
Код
Function NumsWithComment$()
  Dim rg As Range, d, dr&
  Set d = CreateObject("Scripting.Dictionary"): Set rg = [f1]
  Do While True
    Set rg = rg.End(xlDown): If rg.Row = Rows.Count Then Exit Do
    If Not rg.Comment Is Nothing Then
      If Not IsEmpty(rg.Offset(1)) Then Set rg = rg.End(xlDown):  dr = 1
      d(rg.Offset(dr, 1).Value) = 1: dr = 0
    End If
  Loop
  NumsWithComment = "Найдено:" & vbLf & Join(d.keys, ", ")
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Kuzmich, спасибо,- чётко объяснили!
 
Ігор Гончаренко, не подскажете: как запустить вашу "Function"?
Страницы: 1
Наверх