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

Страницы: 1
Как получить такой формат даты 2016_06
 
Попробуйте ТЕКСТ(A9;"ГГГГ&Chr(95)&ММ")  
Изменение индекса переменной в цикле FOR
 
А теперь можете объяснить, что вы хотите от цикла?
Потому что первая строчка цикл for от i = 1 потом сразу переназначаете это же i = номер строки активной ячейки и выделяете диапазон до конца заполненнных ячеек.Переменная ni не равна и не как не связана с i, массивы в VBA задаются по-другому. Переменная i не влияет на данный цикл.Пример, пожалуйста приложите.
Изменено: Eternity - 04.09.2018 17:02:06
Перенос столбца "Категории" в строчку, как идентификатор товаров в категории при импорте
 
Код
Sub îðü2()
Dim i, k, a, s As Integer

Dim number() As Integer

k = Sheets("Ëèñò1").UsedRange.Rows.Count
a = 0

For i = 2 To k
 If Cells(i, 7).Value <> Cells(i - 1, 7).Value Then
    a = a + 1
 End If

Next i
 ReDim number(a)
 a = 0
 For i = 2 To k
 If Cells(i, 7).Value <> Cells(i - 1, 7).Value Then
    number(a) = i
    a = a + 1
   End If
Next i
For i = a - 1 To 0 Step -1
s = number(i)
Cells(s, 8).EntireRow.Insert
Cells(s, 1) = Cells(s + 1, 7)
Cells(s, 1).Font.Bold = False

Next i

For i = 3 To k
 If Cells(i, 8).Value <> Cells(i - 1, 8).Value And Cells(i, 8).Value <> " " Then
    a = a + 1
 End If

Next i
 ReDim number(a)
 a = 0
 For i = 3 To k
 If Cells(i, 8).Value <> Cells(i - 1, 8).Value And Cells(i, 8).Value <> " " Then
     number(a) = i
    a = a + 1
   End If
Next i
For i = a - 1 To 0 Step -1
s = number(i)
Cells(s, 8).EntireRow.Insert
Cells(s, 1) = Cells(s + 1, 8)
Next i
For i = k To 1 Step -1
If Application.CountA(Rows(i)) = 0 Then Rows(i).Delete

Next i


End Sub

Срабатывает одноразово.
Изменено: Eternity - 29.08.2018 21:31:35
Сравнение списков по двум столбцам с выводом результата отличия, VBA
 
Код
Sub Find_Matches()
    Dim x As Variant
  
        
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    For Each x In Selection
        
                
             Select Case x
             Case Is = x.Offset(0, -2)
              Select Case x.Offset(0, -1)
              Case Is = x.Offset(0, 1)
               x.Offset(0, 2) = "Cовпадает"
              Case Else
               x.Offset(0, 2) = "Разное количество"
              End Select
             Case Else
             x.Offset(0, 2) = "Нет кода"
            End Select
            
 
       
    Next x

End Sub
Не нужен Вам <берег турецкий CompareRange. Запускаете по-прежнему на "Как надо")
Изменено: Eternity - 29.08.2018 00:43:02
Сравнение списков по двум столбцам с выводом результата отличия, VBA
 
Код
Sub Find_Matches()
   
    Dim a, k As Integer
    k = Sheets("Как надо").UsedRange.Rows.Count
  
   For a = 2 To k
   Select Case Cells(a, 1).Value
   Case Is = Cells(a, 3).Value
    Select Case Cells(a, 2).Value
      Case Is = Cells(a, 4).Value
       Cells(a, 5).Value = "совпадает"
    Case Else: Cells(a, 5).Value = "разное количество"
   End Select
   Case Else: Cells(a, 5).Value = "нет кода"
   End Select
   Next a
End Sub

Запускаете на "Как надо")
Сейчас попробую доделать по Range, а не по столбцу.
Изменено: Eternity - 29.08.2018 00:06:42
Поиск и выгрузка
 
В виде макроса. Если будете менять имя листа: в коде его тоже заменяйте.
Код
Sub выгрузка()
Dim i, k As Integer
'Подсчет количества строк
k = Sheets("Информация").UsedRange.Rows.Count
'Задание цикла 
For i = 2 To k
'Проверка наличия GP
If Sheets("Информация").Cells(i, 3).Value Like "GP*" Then
Sheets("Выгрузка").Cells(i, 2).Value = Sheets("Информация").Cells(i, 1).Value
Sheets("Выгрузка").Cells(i, 1).Value = Sheets("Информация").Cells(i, 3).Value
Else
Sheets("Выгрузка").Cells(i, 2).Value = Sheets("Информация").Cells(i, 3).Value
Sheets("Выгрузка").Cells(i, 1).Value = Sheets("Информация").Cells(i, 1).Value
End If
Next
End Sub
Изменено: Eternity - 27.08.2018 02:00:29
Нахождение даты окончания работ по задаче
 
Код
' Функция поиска нужной ячейки
Public Function find(nM1 As Integer, nM2 As Integer)
nM1 = 1
Do Until Cells(nM2, 4).Value = Cells(nM1, 4).Value And Cells(nM2, 2).Value = Cells(nM1, 2).Value
nM1 = nM1 + 1
Loop
If Cells(nM2, 4).Value <> Cells(nM1, 4).Value Then
MsgBox ("Работа не будет выполнена")
nM1 = 1
End If
find = nM1
End Function

Sub кол-во часов()
Dim k, i, l As Integer
k = 0
i = find(0, 9)
Do While k <= Range("C9").Value
k = Cells(i, 5).Value + k
i = i + 1
Loop
i = i - 1
Range("E7").Value = Cells(i, 4).Value
l = Range("A8:E9").Rows.Count
MsgBox (find(0, 9))
End Sub
Изменено: WhatisВПР - 25.08.2018 13:07:22
Определить интервал между датами только VBA, Есть две даты, надо вычислить интервал в кол-ве лет, мес, дней
 
Цитата
Kuzmich написал:
А вот префикс "y" почему-то выдает количество дней = 397Остальные префиксы "md", "ym" и "yd" дают ошибку
Потому что "yyyy" вместо "y"
Страницы: 1
Наверх