Добрый день. Подскажите где может быть ошибка. В модуль листа вписал 2 кода. При перестановке местами работает только первый. В чем может быть проблема? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Then Exit Sub Dim q&: q = Target.Row: If q < 1 Then Exit Sub With CreateObject("Outlook.Application") With .CreateItem(0) .To = "9228065000@mail.ru; 904873@mail.ru ; pasha_jerr.ru@mail.ru " .Subject = "Назначен монтаж на - " & Cells(q, 2) & " клиенту: " & Cells(q, 3) .Body = "Контрагент: " & Cells(q, 2) & vbCrLf & _ "Дата монтажа - " & Cells(q, 2) & " Город монтажа - " & Cells(q, 6) & vbCrLf & _ "Адрес монтажа - : " & Cells(q, 7) & vbCrLf & _ "Монтажные работы: 1. Монтаж точек -: " & Cells(q, 9) & "; 2. Монтаж сот-лайн - " & Cells(q, 10) & "; 3. Монтаж микротик - " & Cells(q, 11) & vbCrLf & _ "Полная информация в отчете, в листе Общий график монтажей" .Display ' если нужно посмотреть письмо .Send End With End With Dim c&, r&, i&, n&, m$, s$, d(), v() c = Target.Column Select Case c Case 2, 3, 17 r = Target.Row If r > 2 Then r = r - 2 v = Cells(3, 2).Resize(Cells(Rows.Count, 17).End(xlUp).Row - 2, 16).Value On Error Resume Next s = v(r, 16) With Worksheets(s) n = v(r, 1) d = .UsedRange.Columns(2).Value For i = 1 To UBound(d) If d(i, 1) = n Then For r = r - 1 To 1 Step -1 If v(r, 1) <> n Then Exit For Next r = r + 1 For r = r To UBound(v) If v(r, 1) <> n Then Exit For If v(r, 16) = s Then m = m & ", " & v(r, 2) Next If Len(m) Then .Cells(i, 3) = Mid$(m, 3) Exit For End If Next End With End If End Select
End Sub
[/vba]
Добрый день. Подскажите где может быть ошибка. В модуль листа вписал 2 кода. При перестановке местами работает только первый. В чем может быть проблема? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Then Exit Sub Dim q&: q = Target.Row: If q < 1 Then Exit Sub With CreateObject("Outlook.Application") With .CreateItem(0) .To = "9228065000@mail.ru; 904873@mail.ru ; pasha_jerr.ru@mail.ru " .Subject = "Назначен монтаж на - " & Cells(q, 2) & " клиенту: " & Cells(q, 3) .Body = "Контрагент: " & Cells(q, 2) & vbCrLf & _ "Дата монтажа - " & Cells(q, 2) & " Город монтажа - " & Cells(q, 6) & vbCrLf & _ "Адрес монтажа - : " & Cells(q, 7) & vbCrLf & _ "Монтажные работы: 1. Монтаж точек -: " & Cells(q, 9) & "; 2. Монтаж сот-лайн - " & Cells(q, 10) & "; 3. Монтаж микротик - " & Cells(q, 11) & vbCrLf & _ "Полная информация в отчете, в листе Общий график монтажей" .Display ' если нужно посмотреть письмо .Send End With End With Dim c&, r&, i&, n&, m$, s$, d(), v() c = Target.Column Select Case c Case 2, 3, 17 r = Target.Row If r > 2 Then r = r - 2 v = Cells(3, 2).Resize(Cells(Rows.Count, 17).End(xlUp).Row - 2, 16).Value On Error Resume Next s = v(r, 16) With Worksheets(s) n = v(r, 1) d = .UsedRange.Columns(2).Value For i = 1 To UBound(d) If d(i, 1) = n Then For r = r - 1 To 1 Step -1 If v(r, 1) <> n Then Exit For Next r = r + 1 For r = r To UBound(v) If v(r, 1) <> n Then Exit For If v(r, 16) = s Then m = m & ", " & v(r, 2) Next If Len(m) Then .Cells(i, 3) = Mid$(m, 3) Exit For End If Next End With End If End Select