Сообщений в теме: 914

[xaxu]

Добрый день

подскажите какую вводить формулу , что бы при приближении ( за неделю ) до заданной даты ячейка меняла цвет автоматически ? 

Буду очень благодарна 

[технолог]

Добрый день

подскажите какую вводить формулу , что бы при приближении ( за неделю ) до заданной даты ячейка меняла цвет автоматически ? 

Буду очень благодарна 

Условным форматированием попробуйте или макрос надо писать. Формула примерно такая =($А1-7)<ТДАТА(), где $А1 - это ячейка с датой.

[Demka_DV]

Добрый день

подскажите какую вводить формулу , что бы при приближении ( за неделю ) до заданной даты ячейка меняла цвет автоматически ? 

Буду очень благодарна 

 

По скольку мы не можем угадать, как это должно выглядеть на листе, предложу вот это:

Прикрепленные файлы

•  Kalendar.rar   33,82К   Количество загрузок: 102

[Demka_DV]

Картинка по уловному форматированию

[punter]

подскажите, пожалуйста: имеется строка, где в 1-ой ячейке имеется наименование, далее следуют еще 5 ячеек, которые связаны с первой (являются его характеристикой), каким образом при траспонировании сохранить теперь уже для каждой ячейки наименование?

[Daulet.tech]

примерно так...

Sub www()
    Dim a(), c(), i&, y&, z
    a = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim c(1 To UBound(a) * 5, 1 To 6): z = 0
    For i = 1 To UBound(a)
        For y = 2 To 6: z = z + 1
            c(z, 1) = a(i, 1)
            c(z, 2) = a(i, y)
    Next y, i
    [h2].Resize(z - 1, 6).Value = c
End Sub

[технолог]

подскажите, пожалуйста: имеется строка, где в 1-ой ячейке имеется наименование, далее следуют еще 5 ячеек, которые связаны с первой (являются его характеристикой), каким образом при траспонировании сохранить теперь уже для каждой ячейки наименование?

Транспонированием - никак. Транспонирование преобразует горизонтальные ячейки в вертикальные и наоборот. А у вас как были заголовки по горизонтали, так и остались. Если таблица большая, то через сводную попробуйте.

[punter]

 

примерно так...

Sub www()
    Dim a(), c(), i&, y&, z
    a = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim c(1 To UBound(a) * 5, 1 To 6): z = 0
    For i = 1 To UBound(a)
        For y = 2 To 6: z = z + 1
            c(z, 1) = a(i, 1)
            c(z, 2) = a(i, y)
    Next y, i
    [h2].Resize(z - 1, 6).Value = c
End Sub

отлично! спасибо

UPD: если вдруг число ячеек растет (сейчас это 5), то что мне нужно изменить в коде?

Сообщение отредактировал punter: 14.01.2014, 18:50:41

[Daulet.tech]

Sub www()
Dim a(), c(), i&, y&, z
a = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value'это диапазон
ReDim c(1 To UBound(a) * 5, 1 To 2): z = 0' *5 - это 5 раз больше размер, так как у Вас 5 столбиков вводите в 1 столбик
For i = 1 To UBound(a)
For y = 2 To 6: z = z + 1'2 To 6 - столбы
c(z, 1) = a(i, 1)
c(z, 2) = a(i, y)
Next y, i
[h2].Resize(z - 1, 2).Value = c
End Sub

меняете где примечании, если столбиков 10 то тогда где 5 на 10, 6 на 11, Вашем случаи

1 To 6 заменил на 1 To 2

Resize(z - 1, 6) заменил на Resize(z - 1, 2)

[punter]

существует ли способ автоматической замены значений?

есть              нужно

13 Jan 2014 13.01.2014 

12 Feb 2014 12.02.2014 

03 Mar 2013 03.03.2013 

28 Apr 2012 28.04.2012

Сообщение отредактировал punter: 16.01.2014, 14:56:25

[punter]

глюк

Сообщение отредактировал punter: 16.01.2014, 14:54:56

[Daulet.tech]

28 Apr 2012

значение или формат ячеек?

если значение тогда: =ДАТА(ПРАВБ(A1;4);СУММ(ПОИСКПОЗ(ПСТР(A1;4;3);{"jan";"feb";"mar";"apr"};0)*1);ЛЕВБ(A1;2)), далее добавьте "apr" и .тд.

[Nigrum cygnum]

Подскажите, можно ли как то использовать след формулу?

Dim dt1 as Date

Dim dt2 as Date

 

dt1 = "01.01.2001"

dt2 = "01.02.2001"

 

For i = 1 to 2

Worksheets(1).Range("a1").Value = "dt" & i

Next i

 

 

Проблема в том, что он ставит в ячейку А1 = dt1, а не саму дату. Подскажите как переделать формулу?

А то мне пришлось ссылаться на ячейку и делать цикл привязанный к offset

[Demka_DV]

Подскажите, можно ли как то использовать след формулу?

Dim dt1 as Date

Dim dt2 as Date

 

dt1 = "01.01.2001"

dt2 = "01.02.2001"

 

For i = 1 to 2

Worksheets(1).Range("a1").Value = "dt" & i

Next i

 

 

Проблема в том, что он ставит в ячейку А1 = dt1, а не саму дату. Подскажите как переделать формулу?

А то мне пришлось ссылаться на ячейку и делать цикл привязанный к offset

Все правильно, "dt" & i это не есть dt1 или dt2 - это строка.

 

Sub Dates1()
Dim Array_dt(0 To 1) As Date
Array_dt(0) = "01.01.2001"
Array_dt(1) = "01.02.2001"
For i = 0 To 1
Worksheets(1).Range("A" & i + 1).Value = Array_dt(i)
Next i
End Sub

Сообщение отредактировал Demka_DV: 17.01.2014, 22:47:08

[Daulet.tech]

вариант

Sub Dates1()
    Dim Array_dt()
    Array_dt = Array("01.01.2001", "01.02.2001")
    For i = 0 To 1
        Worksheets(1).Range("a" & i + 1).Value = DateValue(Array_dt(i))
    Next i
End Sub

[Demka_DV]

DauletAhamanov 

Сообщение отредактировал Demka_DV: 17.01.2014, 23:00:29

[Nigrum cygnum]

 

вариант

 

Блин, Даулет, Вы же писали мне про массивы, я стараюсь, простите, что повторяюсь. В поиске Гугла пытался найти через "цикл, переменная, привязка"... 

[Daulet.tech]

без цикла _

Sub Dates1()
    Dim Array_dt()
    Array_dt = Array("01/01/2001", "01/02/2001")
    Worksheets(1).[c1].Resize(UBound(Array_dt) + 1) = Application.Transpose(Array_dt)
End Sub

[Nigrum cygnum]

Подскажите, как удобно транспортировать таблицу на листы?

 

Пример - по столбцам "Human 1...n", они разбросаны. Плюс первый столбец -наименования.

Я в принципе мог бы отсортировать, и по сортировке разбросать Human по листам, т.е. лист 1 = human 1 и т.д.

 

Но, хотелось бы именно макросом сделать это.

 

Для примера выкладываю файл - 

 ForTransp.rar   12,51К   Количество загрузок: 88

 

Наверное надо как-то так:

If Range("...").Offset(0,0+i) = "Human"&i
Then Range("...").Offset(0,0+i).EntireColumn.Copy                    

[Daulet.tech]

Так?

Sub www()
    Dim a(), c(), b(), q&, w&, ii&, i&
    Dim coll As New Collection, txt, newarr
    
    With Sheets("All")
        a = .Range(.[a1], .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Column)).Value
        b = Application.Transpose(.Range(.[b1], .Cells(1, .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Column)).Value)
    End With
    
    '--извлекаем уникальных из первой строки
    On Error Resume Next
    For i = 1 To UBound(b)
        txt = Trim(b(i, 1))
        coll.Add txt, txt
    Next i
    ReDim newarr(1 To coll.Count, 1 To 1)
    For i = 1 To coll.Count
        newarr(i, 1) = coll(i)
    Next
    '--конец
    
        ReDim c(1 To UBound(a), 1 To UBound(newarr))
        For q = 1 To UBound(newarr)
        ii = 1
        For i = 1 To UBound(b)
            If newarr(q, 1) = b(i, 1) Then
                ii = ii + 1
                For w = 1 To UBound(a)
                    c(w, 1) = a(w, 1)
                    c(w, ii) = a(w, i + 1)
                Next
            End If
        Next
        Sheets.Add(, Sheets(Sheets.Count)).Name = newarr(q, 1) '--Создаем листы из массива
        Sheets(newarr(q, 1)).[a1].Resize(w - 1, ii).Value = c
    Next
End Sub

Сообщение отредактировал DauletAhamanov: 21.01.2014, 14:53:15