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

Страницы: 1 2 След.
Невозможно вставить строку, Что блокирует вставку строки
 
Здравствуйте! Имеется два файла "база" и "рабочий". В файле "база" загружаются данные из разных источников и считается очень много формул. А в "рабочий" с помощью запросов PQ вытаскиваются только значения из файла "база". Почему то в "рабочем" невозможно вставить пустую строку между строками с данными из файла "база", что-то блокирует это простое действие! Когда вырезаю и смещаю конкретную таблицу в "рабочем" файле все впорядке, а когда хочу вставить пустую строку то не дает вставить.  Как пример два файла приложены. Как в рабочем файле вставить строку не вырезая каждую область и не опуская ее на нужное колличество строк?
Изменено: Тимур - 08.11.2023 22:32:13
Изменить функцию в PQ. чтобы она корректно работала и на MacOs, как учесть что эта функция должна работать и на MacOS
 
Цитата
написал:
попробую помочь в понедельник.
Спасибо
Изменить функцию в PQ. чтобы она корректно работала и на MacOs, как учесть что эта функция должна работать и на MacOS
 
Цитата
написал:
Досрочный ответ - можно ))... не занимаю
А можете посоветовать кто может?)))
Изменить функцию в PQ. чтобы она корректно работала и на MacOs, как учесть что эта функция должна работать и на MacOS
 
Так никто и не откликнулся! Может быть этот запрос можно заменить макросом? Чтобы он на Маке заработал?
Скорость работы excel, Как увеличить скорость excel
 
Здравствуйте! У меня новый MacBook air 15. На нем установлен office 365 имеется Excel файл и с ним на MacBook имеются проблемы, а именно он очень медленно откликается на разные простые действия. К примеру имеется столбец и я к нему применяю фильтр. Когда я выбираю, что именно отфильтровать, то Excel зависает на 1-2 секунды и потом это действие выполняется, к примеру снять галочку с одного из значений в фильтре. Он при таком простом действии слишком долго думает. При этом у меня есть ноутбук на windows и там это же действие выполняется практически мгновенно и этом windows ноутбук очень старый ему 7 лет!!!! Почему Excel на MacBook так сильно тормозит, а на старом windows ноутбуке это действие выполняется мгновенно?
Мониторинг цен на WB, ошибка при мониторинге цен на WB
 
WB исправил задвоение sale, проблема временно исчезла))))
Мониторинг цен на WB, ошибка при мониторинге цен на WB
 
Цитата
написал:
Сайт по запросу иногда возвращает некорректный json, в котором один и тот же параметр sale повторяется 2 раза.
(примерно для 10-15% товаров такая ошибка)
То есть ответ сайта имеет вид типа {..., " sale ":0, "price":24500, " sale ":0, "stock":8, ...}
Да уже обнаружил такое задвоение sale, но сейчас абсолютно для всех товаров поставленных в мониторинг этот параметр задвоился. Сейчас к примеру мониторится 1326 артикулов и у всех такое задвоение. Может WB специально это сделал? Или такой глюк время от времени только появляется? Рандомно проверил другие товары с WB такое ощущение, что они то сделали специально, для всех товаров выдается задвоение sale
Изменено: Тимур - 05.05.2023 20:46:12
Мониторинг цен на WB, ошибка при мониторинге цен на WB
 
Здравствуйте! Помогите понять, что за ошибка, имеется файл который мониторит цены товаров на WB, перестал работать, в Power Query возникает ошибка:
"В запросе "" произошла ошибка. DataFormat.Error: Повторяющееся имя "sale"."
Что это за ошибка не могу понять. файл пример во вложении.
Единственное изменение, которое я обнаружел это ответ от WB, который возвращается, а именно раньше возвращал: "spp":0, а теперь возвращает "spp":0®ions =80,64,83,4,38,33,70,82,69,68,86,30,40,48,1,22,66,31
Спасибо
Изменено: Тимур - 05.05.2023 19:53:46
PQ не видит всего кода сайта, При парсинге старницы PQ видит только часть кода
 
Цитата
написал:
Цитата
Где об этом подробнее узнать?
Нигде
Только если потратить много дней на изготовление парсеров для сайта wildberries, чем я занимаюсь на протяжении последних 5 лет
Здравствуйте! хотел уточнить, а для ОЗОНА какие параметры надо использовать? на основе этого парсера?
Код
let
    url = "https://card.wb.ru/cards/detail",
    headers = [
        #"Accept" = "*/*",
        #"Accept-Language" = "en-US,en;q=0.9",
        #"Connection" = "keep-alive",
        #"Origin" = "https://www.wildberries.ru",
        #"Referer" = "https://www.wildberries.ru/catalog/"&art&"/detail.aspx?targetUrl=GP",
        #"Sec-Fetch-Dest" = "empty",
        #"Sec-Fetch-Mode" = "cors",
        #"Sec-Fetch-Site" = "cross-site",
        #"User-Agent" = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/107.0.0.0 Safari/537.36",
        #"sec-ch-ua" = "^\^Google",
        #"sec-ch-ua-mobile" = "?0",
        #"sec-ch-ua-platform" = "^\^Windows^^"
    ],
    parameters = [
        #"spp" = "26",
        #"regions" = "80,64,83,4,38,33,70,82,69,68,86,30,40,48,1,22,66,31",
        #"pricemarginCoeff" = "1.0",
        #"reg" = "1",
        #"appType" = "1",
        #"emp" = "0",
        #"locale" = "ru",
        #"lang" = "ru",
        #"curr" = "rub",
        #"couponsGeo" = "2,12,7,3,6,18,21",
        #"sppFixGeo" = "4",
        #"dest" = "-1029256,-85617,-543140,-1586279",
        #"nm" = art
    ],
    response = Web.Contents(url, [
        Query = parameters,
        Headers = headers
    ]),
    json = Json.Document( response ),
    totable = Table.PromoteHeaders(Table.Transpose(Record.ToTable(json[data][products]{0}))),
    #"Removed Columns" = Table.SelectColumns(totable,{"id", "name", "brand", "priceU", "sale", "salePriceU","sizes","rating"}),
    #"Divided Column" = Table.TransformColumns(#"Removed Columns", {{"priceU", each _ / 100, type number}, {"salePriceU", each _ / 100, type number}})
in
    #"Divided Column"
Помогите оптимизировать макрос
 
Цитата
написал:
Тимур, на словаре.
Добавил апострофы, потому что копирую не диапазон с форматом, а только данные, и Эксель своевольничает, это проще победить апострофом. И надёжнее.

Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72  73  74      Private   Sub   Workbook_Open()             Dim   ws1   As   Worksheet, ws2   As   Worksheet, i&, i1&, a, t$, x&          Dim   lLastRow1   As   Long  , lLastRow2   As   Long  , n   As   Long          Dim   fcell   As   Range, lLastRow2new   As   Long             Application.ScreenUpdating =   False          Application.Calculation = xlCalculationManual                   Set   ws1 = Sheets(  "Мониторинг Вык.,Зак.,Ост."  )          Set   ws2 = Sheets(  "Архив"  )          lLastRow1 = ws1.Cells(ws1.Rows.Count, 21).  End  (xlUp).Row          lLastRow2 = ws2.Cells(ws2.Rows.Count, 21).  End  (xlUp).Row          With   CreateObject(  "Scripting.Dictionary"  )       a = ws2.Range(  "U3:Z"   & lLastRow2).Value       For   i = 1   To   UBound(a)    t = a(i, 2) &   "|"   & a(i, 6)    .Item(t) = 0&    Next       a = ws1.Range(  "U3:Z"   & lLastRow1).Value       For   i = 1   To   UBound(a)    t = a(i, 2) &   "|"   & a(i, 6)    If   Not   .exists(t)   Then    i1 = i1 + 1    a(i1, 1) = a(i, 1)    For   x = 2   To   6: a(i1, x) =   "'"   & a(i, x):   Next    .Item(t) = 0&    End   If    Next       If   i1 > 0   Then   ws2.Cells(lLastRow2 + 1, 21).Resize(i1, 6).Value = a       End   With                lLastRow1 = ws1.Cells(ws1.Rows.Count, 33).  End  (xlUp).Row          lLastRow2 = ws2.Cells(ws2.Rows.Count, 33).  End  (xlUp).Row       With   CreateObject(  "Scripting.Dictionary"  )    i1 = 0       a = ws2.Range(  "AG3:AL"   & lLastRow2).Value       For   i = 1   To   UBound(a)    t = a(i, 6)    .Item(t) = 0&    Next       a = ws1.Range(  "AG3:AL"   & lLastRow1).Value       For   i = 1   To   UBound(a)    t = a(i, 6)    If   Not   .exists(t)   Then    i1 = i1 + 1    a(i1, 1) = a(i, 1)    For   x = 2   To   6: a(i1, x) =   "'"   & a(i, x):   Next    .Item(t) = 0&    End   If    Next       If   i1 > 0   Then   ws2.Cells(lLastRow2 + 1, 33).Resize(i1, 6).Value = a       End   With       Application.Calculation = xlCalculationAutomatic    Application.ScreenUpdating =   True       End   Sub   
 
Просто пушка!!!! летает, огонь, спасибо))))
Функция для получения пути к файлу
 
Цитата
написал:
Тимур, посмотрите  здесь
Спасибо за ссылку то, что надо))))
Помогите оптимизировать макрос
 
Цитата
написал:
Кстати findnext - это не брать следующее значение и искать один раз, а искать далее это же значение!
Да это я пытался его ускорить, но неудачно этот код вообще не работает, а тот что работает, он очень долго работает, вот этот код который работает, но долго:
Код
Private Sub Workbook_Open()
Application.Calculation = xlCalculationManual
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
Dim fcell As Range, lLastRow2new As Long

Set ws1 = Sheets("Мониторинг Вык.,Зак.,Ост.")
Set ws2 = Sheets("Архив")
lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

For n = 3 To lLastRow1 + 1
If ws1.Cells(n, 27) <> "" Then
Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(n, 27), LookIn:=xlValues)
If fcell Is Nothing Then
lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
End If
End If
Next

lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

For n = 3 To lLastRow1 + 1
If ws1.Cells(n, 38) <> "" Then
Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(n, 38), LookIn:=xlValues)
If fcell Is Nothing Then
lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
End If
End If
Next

ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.Calculation = xlCalculationAutomatic
End Sub
Помогите оптимизировать макрос
 
Цитата
написал:
Где-то я уже видел такие данные... Там не решилось разве, или там была другая задача?
Другая, там была вообще задача скопировать все данные, сейчас немного тот код изменил, копирует уже две таблице одновременно, при этом сдвинул таблицы в другое место. Но выполняется этот макрос очень долго.
Изменено: Тимур - 02.02.2023 01:14:23
Помогите оптимизировать макрос
 
Цитата
написал:
Тимур, сделайте пример файла, будет время напишу код.
Да вот пример
Архив2.2.xlsm
Помогите оптимизировать макрос
 
Цитата
написал:
Я обычно использую словарь.
Алгоритм простой - сперва циклом по одному массиву данных наполняем словарь, затем циклом по второму массиву данных сверяемся со словарём.
Тут по коду видно что происходит копирование новых данных в архив, значит сперва наполняем словарь из архива, затем копируем те записи, которых нет в словаре (т.е. в архиве) (и одновременно можно пополнять словарь).
Т.к работать можно не с ячейками, а с массивами - всё будет очень быстро.
Можете помочь поправить?
Функция для получения пути к файлу
 
У меня похожая проблема , но немного другая одновременно, использую эту функцию =ЛЕВСИМВ(ЯЧЕЙКА("имяфайла");НАЙТИ("[";ЯЧЕЙКА("имяфайла");1)-1) Но так как файл лежит на onedrive(но при этом скачен на компьютер) имеет  вполне конкретный адрес на компьютере вида : C:\Users\timur\OneDrive\тест, но данная функция определяет путь к этому файлу вот в таком виде : https://d.docs.live.net/bf5e7cbffef0ec/тест/
Я понимаю, что папка one drive каким то образом на это влияет, но как это исправить. Переместить файл с из папки one drive не вариант. Как это исправить?
Изменено: Тимур - 02.02.2023 01:26:54
Помогите оптимизировать макрос
 
Цитата
написал:
Тимур, добрый вечер.
Можно попробовать использование метода .FindNext() вместо перебора. Это должно значительно ускорить процесс.
Или использование массивов.
Вот так? Но что-то по-моему где-то ошибка потому, что не отрабатывает макрос как надо.
Код
Sub Workbook_Open()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
    Dim fcell As Range, lLastRow2new As Long

    Set ws1 = Sheets("Мониторинг Вык.,Зак.,Ост.")
    Set ws2 = Sheets("Архив")
    lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
    lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

    ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
    ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

    Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(3, 27), LookIn:=xlValues)
    For n = 3 To lLastRow1 + 1
        If ws1.Cells(n, 27) <> "" Then
            If fcell Is Nothing Then
                lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
                ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
            Else
                Set fcell = fcell.FindNext(fcell)
            End If
        End If
    Next

    lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
    lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

    Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(3, 38), LookIn:=xlValues)
    For n = 3 To lLastRow1 + 1
        If ws1.Cells(n, 38) <> "" Then
            If fcell Is Nothing Then
                lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
                ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
            Else
                Set fcell = fcell.FindNext(fcell)
            End If
        End If
    Next

   
ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 
Изменено: Тимур - 01.02.2023 21:15:13
Помогите оптимизировать макрос
 
Цитата
написал:
Тимур, добрый вечер.
Можно попробовать использование метода .FindNext() вместо перебора.
Как можете показать?
Помогите оптимизировать макрос
 
Здравствуйте! Написал макрос, который копирует из листа1 две таблицы в лист2 новые данные, данные в листе2 копятся, а в листе 1 подтягиваются из внешнего источника. Строк очень много простым перебором и сравнение каждой строки в листе1 с листом2 получается очень долго. может есть способ его ускорить?

Код
Private Sub Workbook_Open()
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
 Dim fcell As Range, lLastRow2new As Long

  Set ws1 = Sheets("Лист1")
  Set ws2 = Sheets("Лист2")
  lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
  lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

  ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
  ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

 For n = 3 To lLastRow1 + 1
  If ws1.Cells(n, 27) <> "" Then
   Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(n, 27), LookIn:=xlValues)
    If fcell Is Nothing Then
     lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
     ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
    End If
  End If
 Next

  lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
  lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

 For n = 3 To lLastRow1 + 1
  If ws1.Cells(n, 38) <> "" Then
   Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(n, 38), LookIn:=xlValues)
    If fcell Is Nothing Then
     lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
     ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
    End If
  End If
 Next

ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Изменено: Тимур - 29.01.2023 19:41:25
Ошибка VBA при копировании диапазона
 
Цитата
New написал:
попробуйте так
Код
    [URL=#]?[/URL]       1  2  3            With   Sheets(  "Мониторинг Вык.,Зак.,Ост."  )              .Range(.Cells(n, 21), .Cells(n, 26)).Copy Sheets(  "Архив"  ).Cells(lLastRow2new + 1, 21)          End   With   
  P.S. У каждого Range и у каждого Cells нужно обязательно указывать лист-родитель

Спасибо, помогло)
Ошибка VBA при копировании диапазона
 
Подскажите пожалуйста, на что ругается VBA что ему не нравится?
Изменено: Юрий М - 26.01.2023 11:58:04
макрос для копирования новых данных
 
Всем спасибо отредактировал код под себя с помощью chatGPT этот чат просто бомба)))))

Код
Sub aaa()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

lLastRow1 = ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row
lLastRow2 = Sheets("Архив").Cells(Rows.Count, 15).End(xlUp).Row

ActiveSheet.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-8]&RC[-1]"
Sheets("Архив").Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-8]&RC[-1]"

For n = 2 To lLastRow1 + 1
    If ActiveSheet.Cells(n, 27) <> "" Then
        Set fcell = Sheets("Архив").Range("AA3:AA" & lLastRow2 + 1).Find(ActiveSheet.Cells(n, 27), LookIn:=xlValues)
        If fcell Is Nothing Then
            lLastRow2new = Sheets("Архив").Cells(Rows.Count, 15).End(xlUp).Row
            ActiveSheet.Range(Cells(n, 15), Cells(n, 26)).Copy Sheets("Архив").Cells(lLastRow2new + 1, 15)
        End If
    End If
Next

ActiveSheet.Range("AA3:AA" & lLastRow1 + 1).ClearContents
Sheets("Архив").Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Изменено: Тимур - 24.01.2023 18:01:16
макрос для копирования новых данных
 
Цитата
написал:
Сдвинул исходную таблицу вправо и вниз, изменил код но где-то точно ошибка. Можете подсказать?
макрос для копирования новых данных
 
Цитата
написал:
Спасибо большое все работает))) Остался один вопрос как его настроить, чтобы он при каждом запуске файла автоматически запускался?
макрос для копирования новых данных
 
Цитата
написал:
Если новых строк до пары тысяч - можно строки копировать последовательно по одной.
Да новых строк будет не больше 200-400 при каждом запуске.
только я не напишу этот код сам)))
макрос для копирования новых данных
 
Цитата
написал:
Может для ускорения достаточно анализировать только Column1.srid?
Ну и может ещё дату с временем.
Тогда с использованием словаря довольно быстро проверка отработает, основное время уйдёт на копирование.
Да но ее нужно использовать только вместе со столбцом "статус операции" в этом столбце может быть только два значения S-продажа и R-возврат и соответственно Column1.srid будет один и тот же если будет возврат. То есть уникальное значение будет получаться при сравнении одновременно двух этих столбцов. "статус операции"+Column1.srid
макрос для копирования новых данных
 
Цитата
написал:
Тимур,
а данные каждый раз добавляются новые ниже старых?
Да верно
макрос для копирования новых данных
 
Цитата
ну, ... тогда с Вас пример: как есть (лист или книга А) и как хотелось бы (лист или книга Б).

Да все верно, без примера никак)))) во вложении пример. лист 1 это данные, которые подтягиваются по АПИ, их нужно сохранить в Архив в архиве сейчас ничего нет. То есть нужно сверить лист 1 и архив на наличие в листе 1 новых данных и добавить их в архив.
макрос для копирования новых данных
 
Цитата
написал:
Отчёты комиссионера не проще комбайнить?
Нет не проще.
макрос для копирования новых данных
 
Здравствуйте! помогите с кодом, который будет копировать из одного листа новые данные в таблице в другой лист.
Имеется динамическая таблица продаж, в которую подтягиваются по АПИ данные только за последние 90 дней продаж в столбцах с O до Z, нужно найти новые данные и скопировать их в другой лист. Определить что появились новые данные нужно по всей строке, то есть вся строка от столбца O до столбца Z является уникальной.
То есть условно есть лист "Архив" в котором хранятся все продажи, а есть лист с продажами, в который подтягиваются новые данные, нужно найти новые продажи и перенести их в "Архив"
Изменено: Тимур - 22.01.2023 22:18:31
Страницы: 1 2 След.
Наверх