Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Проблема с автоматическим добавлением в список (макрос)
 
Спасибо за ответ. Делаю как вы указали, но выходит ошибка "Run time error 1004: невозможно получить свойство Match класса WorkSheetFunction. (:
Проблема с автоматическим добавлением в список (макрос)
 
Здравствуйте посетители форума. У меня возникла следующая проблема. Буду очень признателен за помощь.
У меня есть таблица из трех столбцов с взаимосвязанными списками на одном листе и различные списки на втором листе. Я хочу чтобы когда я вводил новую запись в ячейку, список в листе 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 
Изменено: djumadinov - 18.01.2014 17:00:57
Поиск элемента в таблице
 
Спасибо большое.
Поиск элемента в таблице
 
Уважаемые посетители форума,
У меня есть табличка с номерами и датами грузовых таможенных деклараций. Имеется всего 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
Изменено: djumadinov - 01.11.2013 21:15:32
Обратный порядок для диапазона
 
Спасибо, большое за ответ! Так работает.
Обратный порядок для диапазона
 
Здравствуйте, учусь работать с диапазонами в 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" засветился красным.
Выделение нужного фрагмента в слове, Макрос
 
Нет, так тоже не получается.
Выделение нужного фрагмента в слове, Макрос
 
Здравствуйте посетители форума. У меня возникла следующая проблема. Имеется ряд слов, с набором букв, например, "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

Спасибо.
Вставка листа с именем текущей даты.
 
Это как вариант №3.

Код
Sub AddNewSheet()
    Dim ShtName As String, NewName As String
    Dim i As Long
    Dim MySH As Worksheet
    
    ShtName = Format(Date, "dd.mm.yy")
    On Error Resume Next
       
        Set MySH = Sheets(ShtName)
        If MySH Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = ShtName
        Else
            NewName = InputBox("This sheet already exists.")
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewName
        End If
End Sub

Вставка листа с именем текущей даты.
 
Прочитал №3. Пробовал. Работает отлично. Спасибо, автору.

Разбираюсь с     On Error GoTo 0 & On Error Resume Next.
Вставка листа с именем текущей даты.
 
Получилось! Вот так:
Код
Sub AddSheet()
Dim ShtName As String
Dim i As Long
Dim NSheet As Worksheet
ShtName = Format(Date, "dd.mm.yy")
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name = ShtName Then Exit Sub
Next i
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ShtName
End Sub
Вставка листа с именем текущей даты.
 
Написал вот так. Что то не получается: все равно добавляет новые листы 5,6,7 итд. Что я сделал неправильно?
Код
Sub AddSheet()
Dim ShtName As String
ShtName = Format(Date, "dd.mm.yy")
On Error Resume Next
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ShtName
Sheets(1).Activate
On Error GoTo 0
End Sub
Вставка листа с именем текущей даты.
 
Спасибо за идею! Сам бы никогда не додумался. Но как теперь избежать ошибки, когда нужный лист уже вставлен?
Код
Sub AddSheet()
Dim i As Long
Dim ShtName As String
ShtName = Format(Date, "dd.mm.yy" ;) 
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = ShtName
End Sub
Вставка листа с именем текущей даты.
 
Спасибо за ответы. Но мне кажется должно существовать более изящное решение. Я не могу заставить макрос вставлять лист с сегодняшней датой после листа 1. Наверное проблема находится в жирно выделенном фрагменте. Помогите пожалуйста.
[CODE][/CODE]
Sub AddSheet()
Dim i As Long
Dim ShtName As String
ShtName = Format(Date, "dd.mm.yy")

For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name = ShtName Then Exit Sub
Next i
Sheets(ShtName).Add After:=Sheets(1)
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]


Заранее спасибо.
Метод пузырьковой сортировки (одномерный массив)
 
Всем спасибо, понял.
Метод пузырьковой сортировки (одномерный массив)
 
Если разобрать пример {5,2,4,1,3}. То, первым шагом будет сравнение {5,2}. Так как, 5>2,   вид массива после этого шага будет таковым {2;5;4;1;3}. Верно?

Если честно, мне не очень ясно для чего нужен Temp?
Метод пузырьковой сортировки (одномерный массив)
 
Уважаемые посетители форума.
Не могу понять часть следующего макроса. То что выделено жирным шрифтом. Пытаюсь понять: что происходит с массивом, начиная с 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
Сводная таблица не выбирает нужный контракт
 
Доброе время суток всем,  
 
Имеется таблица с покупателями, контрактами, кол-во купленной продукции и.т.д.  
 
Такой вопрос: Почему когда выбираешь конкретного покупателя в сводной таблице, в списке контрактов отображаются все контракты не имеющих отношения к этому покупателю.
Страницы: 1
Наверх