Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор данных макросом из одного листа в сводный лист
 
#1
04.12.2024 15:48:00
Доброго дня Вам.
Есть вопрос по сбору данных из выгруженной базы
На лист А выгружаются данные, а на листе Pivot данные собираются формулой MID MOD
Вопрос в том что макрос виснет после заполнения данных

Вот собственно код
Код
Sub montero()

For n = 3 To ActiveSheet.UsedRange.Rows.Count

    Range("B" & n).Value = Worksheets("A").Range("A" & n).Value
    Range("D" & n).FormulaR1C1 = "=+MID('A'!R[-2]C[-1],5,2)&""/""&MID('A'!R[-2]C[-1],8,3)&""/""&R1C4"
    Range("E" & n).FormulaR1C1 = "=+MOD('A'!R[-2]C[-3],1)"
    Range("F" & n).Value = Worksheets("A").Range("D" & n).Value
    Range("G" & n).FormulaR1C1 = "=+VLOOKUP(RC[-6],base!R2C4:R200C6,3,0)"
    Range("H" & n).FormulaR1C1 = "=+VLOOKUP(RC[-7],base!R2C4:R200C5,2,0)"
    Range("I" & n).Value = Worksheets("A").Range("F" & n).Value
    Range("J" & n).Value = Worksheets("A").Range("H" & n).Value
    Range("K" & n).Value = Worksheets("A").Range("J" & n).Value
    Range("L" & n).Value = Worksheets("A").Range("K" & n).Value

Next n

End Sub

Что я неправильно сделал?
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#2
04.12.2024 15:53:09
Цитата
написал:
Что я неправильно сделал?
П.С. как по мне - неправильно в принципе вставлять формулы макросом. Делайте все вычисления в коде, а на лист выгружайте готовый результат
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
04.12.2024 15:57:28
Вы правы я так и хочу чтоб вычисления были макросом а готовый результат без формул уже выгрузить на лист Pivot
А поскольку подзабыл (в 2004-2010 гг пользовался)как правильно коды писать в голову ничего не приходит  
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#4
04.12.2024 15:59:25
MID и  MOD формулы как тогда макросом составить + например указать что А1 на листе Pivot равна В20 из листа A
Изменено: SerArtur - 04.12.2024 15:59:41
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#5
04.12.2024 16:32:51
Код
Sub montero2()
    
    Dim rPivot As Range
    Set rPivot = Sheets("Pivot").UsedRange
    
    Dim aPivot As Variant
    aPivot = rPivot.FormulaR1C1
    
    Dim aA As Variant
    aA = Sheets("A").UsedRange.Value
    
    With Sheets("base").UsedRange
        Dim baseD As Variant: baseD = .Columns("D:D").Value
        Dim baseE As Variant: baseE = .Columns("E:E").Value
        Dim baseF As Variant: baseF = .Columns("F:F").Value
    End With
    
    Dim yb As Long
    Dim dicBase As Object
    Set dicBase = CreateObject("Scripting.Dictionary")
    For yb = 1 To UBound(baseD, 1)
        dicBase(baseD(yb, 1)) = Array(baseE(yb, 1), baseF(yb, 1))
    Next
    
    Dim aBaseRow As Variant
    Dim n As Long
    For n = 3 To UBound(aPivot, 1)
        If n <= UBound(aA, 1) Then
            aPivot(n, 2) = aA(n, 1)
            aPivot(n, 4) = "'" & Mid(aA(n, 3), 5, 2) & "/" & Mid(aA(n, 3), 8, 3) & "/" & aPivot(1, 4) 'Уберите апостроф, если нужна дата, а не текст.
            aPivot(n, 5) = aA(n, 2) - Int(aA(n, 2))
            aPivot(n, 6) = aA(n, 4)
            
            If Not dicBase.Exists(aPivot(n, 1)) Then
                aPivot(n, 7) = Empty
                aPivot(n, 8) = Empty
            Else
                aBaseRow = dicBase(aPivot(n, 1))
                yb = dicBase.Exists(aPivot(n, 1))
                aPivot(n, 7) = aBaseRow(0)
                aPivot(n, 8) = aBaseRow(1)
                aBaseRow = Empty
            End If
            
            aPivot(n, 9) = aA(n, 6)
            aPivot(n, 10) = aA(n, 8)
            aPivot(n, 11) = aA(n, 10)
            aPivot(n, 12) = aA(n, 11)
        End If
    Next
    rPivot.FormulaR1C1 = aPivot
    
'For n = 3 To ActiveSheet.UsedRange.Rows.Count
'
'    Range("B" & n).Value = Worksheets("A").Range("A" & n).Value
'    Range("D" & n).FormulaR1C1 = "=+MID('A'!R[-2]C[-1],5,2)&""/""&MID('A'!R[-2]C[-1],8,3)&""/""&R1C4"
'    Range("E" & n).FormulaR1C1 = "=+MOD('A'!R[-2]C[-3],1)"
'    Range("F" & n).Value = Worksheets("A").Range("D" & n).Value
'    Range("G" & n).FormulaR1C1 = "=+VLOOKUP(RC[-6],base!R2C4:R200C6,3,0)"
'    Range("H" & n).FormulaR1C1 = "=+VLOOKUP(RC[-7],base!R2C4:R200C5,2,0)"
'    Range("I" & n).Value = Worksheets("A").Range("F" & n).Value
'    Range("J" & n).Value = Worksheets("A").Range("H" & n).Value
'    Range("K" & n).Value = Worksheets("A").Range("J" & n).Value
'    Range("L" & n).Value = Worksheets("A").Range("K" & n).Value
'
'Next n
'mm
End Sub
 
 
 
#6
04.12.2024 17:22:58
Еще вариант
Скрытый текст
Изменено: Sanja - 06.12.2024 05:46:06
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
05.12.2024 09:30:12
МатросНаЗебре Спасибо но матерится на цифру 9
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#8
05.12.2024 09:47:47
Цитата
написал:
матерится на цифру 9
Если в строке
Код
aPivot(n, 9) = aA(n, 6)
то на листе "Pivot" используемая область меньше 9 столбцов.
Если, кончено, именно цифра 9 вызывает ошибку, а не 6.
Изменено: МатросНаЗебре - 05.12.2024 09:49:34
 
 
 
#9
05.12.2024 15:02:06
Почему то кусок кода невлокапит данные из листа bаse
           
Код
If Not dicBase.Exists(aPivot(n, 1)) Then
                aPivot(n, 7) = Empty
                aPivot(n, 8) = Empty
            Else
                aBaseRow = dicBase(aPivot(n, 1))
                yb = dicBase.Exists(aPivot(n, 1))
                aPivot(n, 7) = aBaseRow(0)
                aPivot(n, 8) = aBaseRow(1)
                aBaseRow = Empty
            End If
Изменено: SerArtur - 05.12.2024 15:05:58
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#10
05.12.2024 15:04:59
Sanja и МатросНаЗебре  оба варианта мне нравится, но хочу по кускам разобрать оба макроса и понять как куски кодов работают. Ничего юто еще задам вопросы по кускам кодов?
Учиться никогда не поздно
Изменено: SerArtur - 05.12.2024 15:05:32
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#11
05.12.2024 15:09:21
МатросНаЗебре  плюс строк на Листе А 604 при выполнения кода информация берется с 3 строки
А когда в макросе вместо
Код
...
aPivot(n, 2) = aA(n, 1)
...
пишу
Код
...
aPivot(n, 2) = aA(n - 2, 1)
...
Кода заполняет с 1 строки но до 602 строки
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#12
05.12.2024 15:19:02
Ограничение по строкам внесено в эти две строки
Код
  For n = 3 To UBound(aPivot, 1)
        If n <= UBound(aA, 1) Then
 
 
 
#13
05.12.2024 15:50:26
а как работает этот кусок кода
Я понимаю проверяет на листе base но как? поиндексно?
Код
For Each iKey In arrKeys
    If dicBase.Exists(iKey) Then
      arrPivot(I, 6) = Split(dicBase(iKey), "_")(1) 'номер кассы
      arrPivot(I, 7) = Split(dicBase(iKey), "_")(0) 'товар
      Exit For
    End If
  Next
Изменено: SerArtur - 05.12.2024 15:59:48
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#14
05.12.2024 16:34:55
Это к Sanja.
 
 
 
#15
05.12.2024 16:37:40
Код
With Worksheets("Pivot")
      arrKeys = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
Я так понимаю  arrKeys диапазон уникальных наименований например Ереван_Артур_1 отсяда идет сравнение
Код
For Each iKey In arrKeys    If dicBase.Exists(iKey) Then
      arrPivot(I, 6) = Split(dicBase(iKey), "_")(1) 'номер кассы
      arrPivot(I, 7) = Split(dicBase(iKey), "_")(0) 'товар
      Exit For
    End If
 Next
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#16
05.12.2024 19:47:16
Цитата
написал:
Согласие есть продукт при полном непротивлении сторон
Согласен ничего не имею против, но при полном непротивлении сторон во благо двух сторон, надо двум сторонам приложить усилия и почему нет, даже спорить, чтоб потом подружиться. И это для того надобно, чтобы непротивление сторон оказалось во благо самих сторон и другим на примере соглашения двух, непротивленных сторон.И как совет молодым на будущее, каждое непротивление(понимание, с чистым сердцем, дружба без о всякой корысти и с чистым сердцем) ведет к пониманию двух сторон и не только…
С уважением и без корысти
Изменено: SerArtur - 05.12.2024 19:53:44
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#17
06.12.2024 05:47:39
Цитата
SerArtur написал: а как работает этот кусок кода
Добавил комментарии в код в сообщении #2, заменил файл
Цитата
SerArtur написал: Согласен ничего не имею против
Да это просто подпись - не обращайте внимания)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#18
06.12.2024 10:57:50
Цитата
написал:
Да это просто подпись
Ничего и не "просто подпись".
Из уважения к написавшему с трудом сдерживаюсь, но после неё так и хочется добавить "Хорошо излагает собака. Учитесь, Киса."  :D  :D  :D


Цитата
каждое непротивление ... ведет к пониманию
Совсем не обязательно. Отсутствие противодействия вообще не обязательно равно пониманию. Как минимум, это может быть энергосбережение, без малейшего желания понимания. :D  
Изменено: МатросНаЗебре - 06.12.2024 14:30:05
 
 
 
#19
06.12.2024 14:45:41
Цитата
написал:
Ничего и не "просто подпись". Из уважения к написавшему с трудом сдерживаюсь, но после неё так и хочется добавить "Хорошо излагает собака. Учитесь, Киса."        
Ильф и Петров и высказывания ихних героев это вершина мастерства.
Код
Тайный союз меча и орала! Полная тайна организации! — Только без уголовщины! Кодекс мы должны чтить.

Итак Саня джан может подсобите на счет влокопированя данных макросом с уникальными именами

Например на листе base
МагазинМенеджерКассаТоварномер кассы
Ереван_Артур_1Артур1А1Ереван
Ереван_Арам_2Арам2Б2Ереван
Ереван_Симон_3Симон3В3Ереван
Ереван_Карен_4Карен4Г4Ереван
Абовян_Алина_1Алина1А1Абовян
Абовян_Володя_2Володя2Б2Абовян
Абовян_Артак_3Артак3В3Абовян
А на листе Pivot по Ереван_Артур_1 должны влокапиться Товар и номер кассы  
Изменено: SerArtur - 06.12.2024 14:46:39
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
#20
06.12.2024 14:49:01
Просто не могу врубиться в чем фишка вот этого куска от САНИ
Код
With Worksheets("Pivot")
      arrKeys = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
'..........................................................
For Each iKey In arrKeys
    If dicBase.Exists(iKey) Then
      arrPivot(I, 6) = Split(dicBase(iKey), "_")(1) 'номер кассы
      arrPivot(I, 7) = Split(dicBase(iKey), "_")(0) 'Товар
      Exit For
    End If
  Next
Иногда 1+1 не равно двум, она равна нулю и каждая задача имеет красивое и неверное... решение
Next n
Бухгалтер - человек, который решает ваши проблемы, о которых вы и не знали, путём, который вы не понимаете.
 
 
 
Страницы: 1
Наверх