Здравствуйте посетители форума. У меня возникла следующая проблема. Буду очень признателен за помощь. У меня есть таблица из трех столбцов с взаимосвязанными списками на одном листе и различные списки на втором листе. Я хочу чтобы когда я вводил новую запись в ячейку, список в листе 2 обновлялся автоматически. То есть новая запись добавлялась в конце соответствующего списка в листа 2. На этом сайте есть пример с автоматическим добавлением в один список. Но что делать если таких списков много. Я пытаюсь, но что то не очень получается. Первый столбец еще получается, но второй никак. Записывает в нужный столбец, но добавляет запись даже если она уже существует. Лень каждый раз открывать лист2 и обновлять (или создавать новые) списки вручную. Заранее спасибо.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
LastColumn = Worksheets("List2").Cells(1, Columns.Count).End(xlToLeft).Column
'Block 1
If Not Intersect(Target, Range("Data").Columns(1)) Is Nothing Then
On Error Resume Next
If WorksheetFunction.CountIf(Worksheets("List2").Range("Masters"), Target) = 0 Then
lReply = MsgBox("Do you want to add " & Target & " to dropdown list?", vbYesNo + vbQuestion)
If lReply = vbYes Then
With Worksheets("List2")
.Range("Masters").Cells(.Range("Masters").Rows.Count + 1, 1) = Target
.Cells(1, LastColumn + 1) = Target
.Columns.AutoFit
End With
End If
End If
End If
'Block 2
Position = WorksheetFunction.Match(Target.Offset(0, -1).Value, Worksheets("List2").Rows(1), 0)
LastRow = Worksheets("List2").Cells(Rows.Count, Position).End(xlUp).Row
If Not Intersect(Target, Range("Data").Columns(2)) Is Nothing Then
On Error Resume Next
If WorksheetFunction.CountIf(Worksheets("List2").Range(Cells(2, Position), Cells(LastRow, Position)), Target) = 0 Then
lReply = MsgBox("Do you want to add " & Target & " to dropdown list?", vbYesNo + vbQuestion)
If lReply = vbYes Then
With Worksheets("List2")
.Cells(LastRow + 1, Position) = Target
.Columns.AutoFit
End With
End If
End If
End If
End Sub
Уважаемые посетители форума, У меня есть табличка с номерами и датами грузовых таможенных деклараций. Имеется всего 4 таможенных режима (отмечены желтым цветом) и рядом с ним заполнены даты и номера. Проблема в том что, на первом режиме (70) товар может находится всего два месяца. После чего, его надо оформлять на другой режим. Я хотел бы чтобы моя таблица давала мне знать заранее (10 дней например), срок какой декларации подходит к концу. Я вставил кнопку "проверить" и написал макрос, но он не работает. Подскажите пожалуйста как исправить ошибку.
Код
Sub RangeCheck()
Dim cell As Range
Dim Counter As Long
Counter = 0
For Each cell In Range("Data").Columns(3)
If Not IsEmpty(cell) Then
If Date - cell.Value > 50 And Date - cell.Value < 60 Then
If cell.Offset(0, 3).Value = "" And cell.Offset(0, 6) = "" And cell.Offset(0, 9).Value = "" Then
MsgBox "Deadline is coming", vbInformation
Counter = Counter + 1
cell.Activate
Else
MsgBox "Everything is OK"
End If
End If
End If
Next cell
MsgBox Counter & " record(s) were found."
End Sub
Здравствуйте, учусь работать с диапазонами в Excel. Хотелось написать макрос что бы расположить значения в выделенном диапазоне в обратном порядке. Пример: a, b, c, превращался в c, b, a.
Код выглядит вот так:
Код
Sub ReverseRange()
Dim x As Variant
Dim r As Long, c As Integer
x = Selection.Value
For r = 1 To UBound(x, 1)
For c = 1 To UBound(x, 2)
x(r, c) = x(Abs(r - (Selection.Rows.Count+1)), c)
Next c
Next r
Selection = x
End Sub
Здравствуйте посетители форума. У меня возникла следующая проблема. Имеется ряд слов, с набором букв, например, "dog" в словах.
undog superdog doggystyle doggydog Dog zipdogless
Как сделать так, чтобы сочетание "dog" выделялось красным цветом. Я написал макрос, но он выделяет только если само это слово "dog". Вот мой макрос:
Код
Sub RedDog()
Dim cell As Range
If TypeName(Selection) <> "Range" Then Exit Sub
For Each cell In Selection
If LCase(cell.Value) = "dog" Then
cell.Font.Color = RGB(255, 0, 0)
End If
Next cell
End Sub
Хочу написать макрос который бы проверял есть ли в книге лист с именем сегодняшней даты. Если его нет, то добавлял бы его. Пишу вот так, не получается.
Код
[/CODE]
Sub AddSheet()
Dim ShtName As String
Dim i As Long
ShtName = Format(Date, "dd.mm.yy")
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> Sheets(ShtName) Then
Sheets(ShtName).Add After:=Sheets(1)
End If
Next i
End Sub
[CODE]
Уважаемые посетители форума. Не могу понять часть следующего макроса. То что выделено жирным шрифтом. Пытаюсь понять: что происходит с массивом, начиная с Temp = List(j). прим. {5,2,4,1,3}.
Код
Sub BubbleSort(List() As String)
‘ Sorts the List array in ascending order
Dim First As Long, Last As Long
Dim i As Long, j As Long
Dim Temp As String
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
[B]Temp = List(j)
List(j) = List(i)
List(i) = Temp[/B]
End If
Next j
Next i
End Sub
Имеется таблица с покупателями, контрактами, кол-во купленной продукции и.т.д.
Такой вопрос: Почему когда выбираешь конкретного покупателя в сводной таблице, в списке контрактов отображаются все контракты не имеющих отношения к этому покупателю.