Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
29.03.2024, 05:28:51

Войти
Интересные и полезные статьи по работе с Excel и VBA можно найти в разделе ХИТРОСТИ
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
  Просмотр сообщений
Страниц: [1] 2 3 ... 29
1  Основные форумы / Вопросы по Excel и VBA / Re:Добавление строк в конце таблицы с комментарием VBA : 22.09.2021, 17:27:34
Здравствуйте.
Определяетесь, по каким столбцам идет сопоставление строк, по 5 или 7.
spoiler for Hiden:
Код: (vb)
Sub Обновить()
    Dim Sh As Worksheet, Sh1 As Worksheet, Key As String, rng As Range
    Set C_is = CreateObject("scripting.dictionary")
    Set Sh = ThisWorkbook.Worksheets("новая")
    Set Sh1 = ThisWorkbook.Worksheets("старая")
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    LastRow1 = Sh.Cells(Sh1.Rows.Count, 1).End(xlUp).Row
    dx = Sh.Range("A1:G" & LastRow)
    For n = 2 To UBound(dx)
        Key = dx(n, 1) & "_" & dx(n, 2) & "_" & dx(n, 3) & "_" & dx(n, 4) & _
              "_" & dx(n, 5)
           ' Key  выбор в зависимости от того, как определяете одинаковые строки
            Key = dx(n, 1) & "_" & dx(n, 2) & "_" & dx(n, 3) & "_" & dx(n, 4) & _
              "_" & dx(n, 5) & "_" & dx(n, 6) & "_" & dx(n, 7)
        C_is.Item(Key) = n

    Next

    dx = Sh1.Range("A1:G" & LastRow1)
    For n = 2 To UBound(dx)
   
       Key = dx(n, 1) & "_" & dx(n, 2) & "_" & dx(n, 3) & "_" & dx(n, 4) & _
              "_" & dx(n, 5)
        Key = dx(n, 1) & "_" & dx(n, 2) & "_" & dx(n, 3) & "_" & dx(n, 4) & _
              "_" & dx(n, 5) & "_" & dx(n, 6) & "_" & dx(n, 7)
             
          ' Key  выбор в зависимости от того, как определяете одинаковые строки
             
        If Not C_is.Exists(Key) Then
            If Not rng Is Nothing Then
                Set rng = Union(rng, Sh1.Range("a" & n).Resize(1, 7))
            Else
                Set rng = Sh1.Range("a" & n).Resize(1, 7)
            End If

        End If

    Next

    If Not rng Is Nothing Then
        LastRow = LastRow + 1
        endRow = LastRow + rng.Rows.Count - 1
        rng.Copy Sh.Range("a" & LastRow)
        Set rng = Union(rng, Sh1.Range("a" & n).Resize(1, 7))
        Sh.Range("F" & LastRow & ":h" & endRow).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Sh.Range("H" & LastRow & ":h" & endRow) = "удалена"
    End If
End Sub
2  Прочие форумы / Заказы на написание макросов, работа для специалистов по Excel и VBA и пр. / Re:Нужен специалист, который занимался разработкой приложений (надстроек) Word : 10.02.2021, 20:43:55
Режим обсуждения
3  Прочие форумы / Заказы на написание макросов, работа для специалистов по Excel и VBA и пр. / Re:Нужен специалист, который занимался разработкой приложений (надстроек) Word : 10.02.2021, 09:56:33
Раз желающих нет, напишу в личку
4  Основные форумы / Вопросы по Excel и VBA / Re:Ветвления и циклы не использовать Заданное число N является степенью числа а : 21.03.2020, 20:40:19
Можно я покажу Улыбка , а ТС пускай думает , почему именно так .
Пишу прямо здесь.
Код: (vb)
N = 4
a = Val(InputBox("? ? ?"))
Debug.Print a = 1 Or a = N Or a = N ^ 2 Or N = a ^ 3 Or a = N ^ 4
5  Основные форумы / Вопросы по Excel и VBA / Re:В цикле копировать данные по условию : 25.01.2020, 23:35:44
Можно, но это будет не
Гениальное решение
Код: (vb)
Sub HCopy()
    Dim Sh As Worksheet, rng As Range, rg As Range
      ReDim KPopy(4)
    KPopy(0) = Array(1.1, 2.1, 3.1)
    KPopy(1) = Array(1.1, 2.2, 3.2)
    KPopy(2) = Array(1.1, 2.1, 3.3)
    KPopy(3) = Array(1.1, 2.2, 3.1)
    KPopy(4) = Array(1.1, 2.1, 3.2)

    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    Set rg = Sh.Range("A1:B" & LastRow)
    dx = rg
     LastRow = 3
    For j = 0 To UBound(KPopy)
    KPopy1 = KPopy(j)
      For i = 0 To UBound(KPopy1)
          For n = 4 To UBound(dx)
            If dx(n, 2) = KPopy1(i) Then
            LastRow = LastRow + 1
            Set rng = rg.Rows(n)
          rng.Copy Sh.Range("D" & LastRow)
            End If
        Next
   
      Next
    Next
   
End Sub

6  Основные форумы / Вопросы по Excel и VBA / Re:В цикле копировать данные по условию : 25.01.2020, 22:32:52
Видео здесь.
Код редактируйте под себя.
Он лишь пример выполнения задачи
7  Основные форумы / Вопросы по Excel и VBA / Re:В цикле копировать данные по условию : 25.01.2020, 19:22:08
Здравствуйте.
Так?
spoiler for Hiden:
Код: (vb)
Sub HCopy()
    Dim Sh As Worksheet, rng As Range, rg As Range
    KPopy1 = Array(1.1, 2.1, 3.1)
    KPopy2 = Array(1.1, 2.2, 3.2)
    KPopy3 = Array(1.1, 2.1, 3.3)
    KPopy4 = Array(1.1, 2.2, 3.1)
    KPopy5 = Array(1.1, 2.1, 3.2)
    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    Set rg = Sh.Range("A1:B" & LastRow)
    dx = rg
    KPopy = KPopy1
    GoSub Rachet
    KPopy = KPopy2
    GoSub Rachet
    KPopy = KPopy3
    GoSub Rachet
    KPopy = KPopy4
    GoSub Rachet
    KPopy = KPopy5
    GoSub Rachet
    Exit Sub
Rachet:
    For i = 0 To UBound(KPopy)

        For n = 4 To UBound(dx)

            If dx(n, 2) = KPopy(i) Then
                If rng Is Nothing Then
                    Set rng = rg.Rows(n)
                Else
                    Set rng = Union(rng, rg.Rows(n))
                End If
            End If
        Next
    Next
    If Not rng Is Nothing Then
        LastRow = Sh.Cells(Sh.Rows.Count, "D").End(xlUp).Row + 1
        If LastRow < 4 Then LastRow = 4
        rng.Copy Sh.Range("D" & LastRow)
    End If
    Set rng = Nothing
    Return
End Sub
8  Основные форумы / Вопросы по Excel и VBA / Re:Как присвоить checkbox значение в коде? : 05.01.2020, 20:42:36
Ошиблись форумом.
По картинкам консультируют здесь и здесь
9  Основные форумы / Вопросы по Excel и VBA / Re:Макрос копирования выделенной строки на другой лист : 03.01.2020, 23:31:54
Каким боком скрипт гугл таблиц к excel.
Для переноса одной выделенной строки
Код: (vb)
function _123() {  
  var spreadsheet = SpreadsheetApp.getActive(); 
  var sh= spreadsheet.getSheetByName('Архив'); 
  var sh2= spreadsheet.getSheetByName('Ближайшие заказы'); 
  var rng= sh2.getActiveRange();
  sh.insertRowsBefore(1, 1); 
  rng.copyTo(sh.getRange('a1'), SpreadsheetApp.CopyPasteType.PASTE_NORMAL, false); 
  sh2.deleteRow(rng.getRow()); 
};

Дальше сами фантазируйте
10  Основные форумы / Вопросы по Excel и VBA / Re:ошибка run time error '5': Invalid procedure call or argument : 14.10.2019, 15:21:49
если в стенах университета работает нормально
Вы уверены в этом.
В проекте прописана конечная дата использования файла 07.07.2019.
+ счетчик на 50 раз открыть файл+ проверка времени компа
Файл на помойку несите или с разработчиком связывайтесь.
11  Основные форумы / Вопросы по Excel и VBA / Re:Информация из ячейки на панель ribbon : 12.10.2019, 11:18:02
alex77755 , не путайте ленту и CommandBars.
ТС надо это.
12  Прочие форумы / Заказы на написание макросов, работа для специалистов по Excel и VBA и пр. / Re:Редактировать парсер сайтов : 13.09.2019, 09:40:08
Как показывает практика, легче парсер с нуля написать, чем править чужой.
Шлите на мыло, есть в профиле.
13  Прочие форумы / Заказы на написание макросов, работа для специалистов по Excel и VBA и пр. / Re:Заказ для фирмы, таблицы Exсel. : 20.06.2019, 09:53:43
Юра, вбей телефон +48799266527 в поиск .
14  Прочие форумы / Заказы на написание макросов, работа для специалистов по Excel и VBA и пр. / Re:Требуется макрос/код, скачивающий csv и добавляющий его в базу данных. : 07.06.2019, 00:49:55
Никто не желает, напишу в личку.
15  Основные форумы / Вопросы по Excel и VBA / Re:Получение данных по API Web service : 04.02.2019, 22:36:14
Идем по ссылке http://lana.od.ua/WebService.asmx
Заходим в любой метод и смотрим на примеры  http запросов
Страниц: [1] 2 3 ... 29
Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru