Не совсем так как нужно работает, изменил на:

только нужно еще допилить, чтобы пропускало пустые ячейки и если содержит "-". т.е. отображало только фамилии.

Если с примером, то наверно это будет совсем другая тема. Выложу сюда и изменю постановку попроса, если что не так, надеюсь модераторы перенесут куда надо или изменят имя темы.

нужно таблицу в пункте 4.1 заполнить из таблицы "Таб_ФП" колонки "фио наказанного", "Принятые меры" в зависимости от выбранного месяца и года в строке 5

Добрый день.
Суть вопроса: есть таблица с данными условно за год. Подскажите можно ли сделать именованный диапазон на определенный месяц при условии, что месяц (и год) будет задаваться отдельно в ячейке (выпадающем списке).

т.е. условно:
А1 - выпадающий список месяцев (май), В1 - год(2019).
в именованный диапазон попадают все данные за период с 01.05.2019 по 31.05.2019

ps// между датами могут быть пустые строки

Вопрос снят. Решил с помощью PQ

Наверно ДА

Добрый день. Есть ссылка, по которой вставляются данные в таблицу:
Нужно обновить эти данные, но с другими параметрами (изменить диапазон даты, дата в ячейках условно А1, В1). Подскажите как реализовать, а то приходится лезть менять источник

Doober, спасибо, что отозвались, конечно Ваш вариант имеет место на жизнь, но не всегда есть интернет для доступа к сайту. Я только, что запустил свой вариант.

Подкрутил так. Все равно не пляшет результат. Подолкните хотябы в нужном напрвлении.

Есть функция которая вычисляет CRC-16 но результат не совпадает. Для данного значения "0d84580000000001010800" в hex должно получится AEB1. Проверял на сайте калькулятор crc, совпадает. Помогите подправить.

Добрый день. Нужны макросы а точнее 2-е функции, одна для расчета а вторая для проверки CRC кода. Описание во вложении.

Скрытый текст

Контроль  циклическим  кодом  применяется  для  повышения  надежности  передачи данных. Смысл контроля заключается в следующем. Запрос подвергается шифровке циклическим кодом. Полученный результат добавляется в конец запроса, и весь пакет отправляется подчиненному устройству. Подчиненное устройство выполняет те же действия над байтами запроса и сравнивает полученный результат с CRC принятого пакета, и в случае положительного результата выполняет требуемое действие. Затем оно формирует ответное сообщение, подвергает его той же процедуре шифровки, “ прицепляет ” полученный код в конец пакета и посылает его обратно главному устройству. Главное устройство выполняет ту же процедуру дешифровки, проверяя правильность принятого пакета. Вероятность обнаружения ошибки в одном разряде байта пакета равна 99,998%. В  качестве  примера  рассмотрим  вычисление  CRC  в  виде  функции  написанной  на языке С . Все возможные значения CRC помещены в два массива. Один массив содержит все возможные значения для старшего байта CRC, а второй – для младшего.   const unsigned char tblCRChi[]= { 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40, 0x01, 0xC0, 0x80, 0x41, 0x01, 0xC0, 0x80, 0x41, 0x00, 0xC1, 0x81, 0x40 }; const unsigned char tblCRClo[]= { 0x00, 0xC0, 0xC1, 0x01, 0xC3, 0x03, 0x02, 0xC2, 0xC6, 0x06, 0x07, 0xC7, 0x05, 0xC5, 0xC4, 0x04, 0xCC, 0x0C, 0x0D, 0xCD, 0x0F, 0xCF, 0xCE, 0x0E, 0x0A, 0xCA, 0xCB, 0x0B, 0xC9, 0x09, 0x08, 0xC8, 0xD8, 0x18, 0x19, 0xD9, 0x1B, 0xDB, 0xDA, 0x1A, 0x1E, 0xDE, 0xDF, 0x1F, 0xDD, 0x1D, 0x1C, 0xDC, 0x14, 0xD4, 0xD5, 0x15, 0xD7, 0x17, 0x16, 0xD6, 0xD2, 0x12, 0x13, 0xD3, 0x11, 0xD1, 0xD0, 0x10, 0xF0, 0x30, 0x31, 0xF1, 0x33, 0xF3, 0xF2, 0x32, 0x36, 0xF6, 0xF7, 0x37, 0xF5, 0x35, 0x34, 0xF4, 0x3C, 0xFC, 0xFD, 0x3D, 0xFF, 0x3F, 0x3E, 0xFE, 0xFA, 0x3A, 0x3B, 0xFB, 0x39, 0xF9, 0xF8, 0x38, 0x28, 0xE8, 0xE9, 0x29, 0xEB, 0x2B, 0x2A, 0xEA, 0xEE, 0x2E, 0x2F, 0xEF, 0x2D, 0xED, 0xEC, 0x2C, 0xE4, 0x24, 0x25, 0xE5, 0x27, 0xE7, 0xE6, 0x26, 0x22, 0xE2, 0xE3, 0x23, 0xE1, 0x21, 0x20, 0xE0, 0xA0, 0x60, 0x61, 0xA1, 0x63, 0xA3, 0xA2, 0x62, 0x66, 0xA6, 0xA7, 0x67, 0xA5, 0x65, 0x64, 0xA4, 0x6C, 0xAC, 0xAD, 0x6D, 0xAF, 0x6F, 0x6E, 0xAE, 0xAA, 0x6A, 0x6B, 0xAB, 0x69, 0xA9, 0xA8, 0x68, 0x78, 0xB8, 0xB9, 0x79, 0xBB, 0x7B, 0x7A, 0xBA, 0xBE, 0x7E, 0x7F, 0xBF, 0x7D, 0xBD, 0xBC, 0x7C, 0xB4, 0x74, 0x75, 0xB5, 0x77, 0xB7, 0xB6, 0x76, 0x72, 0xB2, 0xB3, 0x73, 0xB1, 0x71, 0x70, 0xB0, 0x50, 0x90, 0x91, 0x51, 0x93, 0x53, 0x52, 0x92, 0x96, 0x56, 0x57, 0x97, 0x55, 0x95, 0x94, 0x54, 0x9C, 0x5C, 0x5D, 0x9D, 0x5F, 0x9F, 0x9E, 0x5E, 0x5A, 0x9A, 0x9B, 0x5B, 0x99, 0x59, 0x58, 0x98, 0x88, 0x48, 0x49, 0x89, 0x4B, 0x8B, 0x8A, 0x4A, 0x4E, 0x8E, 0x8F, 0x4F, 0x8D, 0x4D, 0x4C, 0x8C, 0x44, 0x84, 0x85, 0x45, 0x87, 0x47, 0x46, 0x86, 0x82, 0x42, 0x43, 0x83, 0x41, 0x81, 0x80, 0x40 }; unsigned short __fastcall CRC16(unsigned char *msg, unsigned short len) {   unsigned short idx;   unsigned char  CRChi = 0xFF;   unsigned char  CRClo = 0xFF;   while(len--)   {      Idx = (CRChi ^ *msg++) & 0xFF;      CRChi = CRClo ^ tblCRChi[idx];      CRClo = tblCRClo[idx];   }   return ((CRChi << 8) | CRClo); } Функции  в  качестве  параметров  принимает  указатель  на  сообщение  используемое для формирования CRC (msg) и размер сообщения в байтах (len), а возвращает 16-ти битное значение CRC.

Все работает. Спасибо.

Добрый день. Нужна помощь. Необходимо "опросить" (получить данные) оборудование,  отправив  (команду "0d 84 58 00 00 00 00 01 01 02 00 b7 0e") в COM порт в hex формате. Когда отправляю ниже приведенным кодом, данные уходят как String, соответственно оборудование не отвечает. пробовал разные варианты, но не получилось. Помогите допилить.

Скрытый текст

Private Sub CommandButton1_Click() Dim adr As String Dim h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, out, inut As Long 'SendSubArray(Buffer as Byte array, NumBytes as Integer) as Integer MSComm1.CommPort = 1 MSComm1.Settings = "9600,N,8,1" MSComm1.InputLen = 0 On Error Resume Next MSComm1.PortOpen = True If Err Then MsgBox "Com" & MSComm1.CommPort & ": not available. Change CommPort property to another port.": MSComm1.PortOpen = False: Exit Sub i = 2    ' Номер строки с которой начинается база lLastRow = Cells(Rows.Count, 1).End(xlUp).Row     ' Номер последней строки в базе 'lLastCol = Cells(1, Columns.Count).End(xlToLeft).Column For i = 2 To lLastRow Step 1 adr = 5884    ' Sheet3.Cells(i, 2).Value ' Номер счетчика для опроса adr = Fun_adress(adr) 'MSComm1.Output = TextBox1.Text h1 = "0d": h2 = "84": h3 = "58": h4 = "00": h5 = "00": h6 = "00": h7 = "00": h8 = "01": h9 = "01": h10 = "02": h11 = "00": h12 = "b7": h13 = "0e" 'out = Chr$(h1) + Chr$(h2) + Chr$(h3) + Chr$(h4) + Chr$(h5) + Chr$(h6) + Chr$(h7) + Chr$(h8) + Chr$(h9) + Chr$(h10) + Chr$(h11) + Chr$(h12) + Chr$(h13) 'out = H1 & Chr(13) & H2 & Chr(13) & h3 & Chr(13) & h4 & Chr(13) & h5 & Chr(13) & h6 & Chr(13) & h7 & Chr(13) & h8 & Chr(13) & h9 & Chr(13) & h10 & Chr(13) & h11 & Chr(13) & h12 & Chr(13) & h13 out = h1 & h2 & h3 & h4 & h5 & h6 & h7 & h8 & h9 & h10 & h11 & h12 & h13 MSComm1.Output = Chr$("0d 84 58 00 00 00 00 01 01 02 00 b7 0e") 'MSComm1.Output = Chr("0d") + Chr("84") + Chr("58") + Chr("00") + Chr("00") + Chr("00") + Chr("00") + Chr("01") + Chr("01") + Chr("02") + Chr("00") + Chr("b7") + Chr("0e") ' 0d 84 58 00 00 00 00 01 01 02 00 b7 0e ' Do ' Dummy = DoEvents() ' Loop Until MSComm1.InBufferCount >= 8 If MSComm1.InBufferCount < 8 Then MsgBox "Com - " & MSComm1.CommPort & ": Нет ответа. Bit-" & MSComm1.InBufferCount: MSComm1.PortOpen = False: Exit Sub TextBox2.Text = MSComm1.Input Next i MSComm1.PortOpen = False End Sub

Спасибо.

Спасибо ОГРОМНОЕ. Все работает.

Доброго времени суток. Есть файл 01300665.210 (имя меняется). Помогите написать макрос, что бы импортировать такие  файлы в эксель одним нажатием кнопки.

Добрый вечер. Я к вам за советом. Я в VBA самоучка. Так случилось, что на работе меня озадачили "создать шаблоны для написания процентовок мастерам" (не моя примая специальность я электрик). Я все это дело соорудил (создал шаблоны, свою панельку, формы для из заполнения, и еще кучу макросов для удобства и максимальной автомаизации процесса). В итоге у меня идин файл размером метра 4. В файле 10 лиистов + добавленые процентовки (1 лист на процентовку). При этом размер файла еще увеливается.    
И теперь этот файл надо раздать мастерам для работы.    
 
Теперь собственно вопрос: Как все это дело упростить (уменьшить размер одно файла)? У меня есть такой вариан, на сколько я понимаю постоении программ:  
1.Создать (уже скопировать) шаблоны в отдельные файлы.xlt  
2.Все формы и макросы с паннелькой отдельный файл (главный файл).xls (или xla что лучше?)  
3.Созданная процентовка сохранялась в отдельный файл (сколькопроцентовок столько и файлов).  
 
Я правильно мыслю? или подскажите свой вариант как оптимально организовать?

Вопрос решён. Сделал проверку ListBox1.ListIndex < 0 . Может кому пригодится...

Из-за чего может строка в ListBox активироватся после второго счелчка? дальше все последующие норма, с первого раза.

тему закрываю

проблемная форма открывается при активации ячейки "Номенкларутный номер"

ссылка на архив http://www.fayloobmennik.net/1848244  
120785

Но я же счелкаю по строке, и вижу сто она выделена. Подскажите что сделать чтобы все заработало?

В ListBox1 все отабражается отлично, но как только счелкаю по какой либо строке сразу ошибка 381. При этом ListBox1.ListIndex=-1. У меня такое чувство что ListBox1.ListIndex не возвращает значение, но почему???

Добрый день. Нужна помощь. Есть форма для заполнения таблицы, на форме имеется ListBox1 в котором отображаются материалы (5 столбцов: 1-номенклатурный номер, 2-Наименование, 3-Ед.изм., 4-Количество, 5-Цена). ListBox1.RowSource присваиваю так (в зависимости от значения ComboBox1):  
     If ComboBox1.Text = .Range("AT7") Then  
       UserForm4.ListBox1.RowSource = "oborot_530"  
     End If  
именованный список oborot_530=СМЕЩ('530'!$AW$9;0;0;СЧЁТЕСЛИ('530'!$AW$9:$AW$2000;">0");5)  
Вот код  
 
Private Sub ListBox1_Click()  
Dim str As String  
Dim pp As String  
Dim vo As String  
Dim korschet As String  
Dim kauk As String  
Dim kvz As String  
Dim dkvz As String  
Dim nomenklat As String  
Dim naimenov As String  
Dim izm As String  
Dim kolvo As String  
Dim cena As String  
Dim vidrab As String  
Dim AL26 As String     ' Вид опрерации  
Dim AM26 As String     ' Кор. счет  
Dim AN26 As String     ' КАУК  
Dim AO26 As String     ' КВЗ  
Dim AR26 As String     ' Доп.КВЗ  
Dim str1 As String  
Dim str2 As String  
   
   TM = 200    'задержка в мс  
   ss = GetTickCount: DoEvents  
   Do While GetTickCount - ss < TM: DoEvents: Loop  
'    ActiveCell = UserForm4.ListBox1.Text  
' на следующей строке останавливается с ошибкой 381      
   TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 0)    ' Инвентарный номер  
   TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 1)    ' Наименование  
   TextBox4.Text = ListBox1.List(ListBox1.ListIndex, 2)    ' Ед. изм  
   TextBox6.Text = ListBox1.List(ListBox1.ListIndex, 4)    ' Цена  
 
   str = ActiveCell.Row  
'-------------------определение КАУК, КВЗ, Кор.счет  
  With ActiveWorkbook.ActiveSheet  
   vidrab = .Range("A4")  
   pp = str - 1  
   pp = .Cells(pp, 1).Value + 1  
  End With  
 
With ActiveWorkbook.Sheets("Дано")  
        str1 = 6   'Номер строки с которой начинать поиск  
        str2 = str1  
    Do Until .Cells(str1, 1).Value = vidrab          'Поиск первой ячейки в 1м столбце соответствующую выбранному авто  
       str1 = str1 + 1                                'перебор номера строк пока не выполнится условие  
         
       If str1 > str2 + 16 Then  
       Exit Sub  
       End If  
    Loop  
   AL26 = .Cells(str1, 9).Value    ' Вид опрерации  
   AM26 = .Cells(str1, 12).Value   ' Кор. счет  
   AN26 = .Cells(str1, 16).Value   ' КАУК  
   AO26 = .Cells(str1, 20).Value   ' КВЗ  
   AR26 = .Cells(str1, 23).Value   ' Доп.КВЗ  
     
End With  
       vo = AL26  
       korschet = AM26  
       kauk = AN26  
       kvz = AO26  
       dkvz = AR26  
       nomenklat = TextBox2.Text  
       naimenov = TextBox3.Text  
       izm = TextBox4.Text  
       kolvo = TextBox5.Text  
       cena = TextBox6.Text  
     
   If nomenklat > 111111111 Then  
     vo = 61  
     kvz = 11  
   End If  
 
     
  With ActiveWorkbook.ActiveSheet  
       Range("A" + str).Value = pp  
       Range("D" + str).Value = vo  
       Range("G" + str).Value = korschet  
       Range("K" + str).Value = kauk  
       Range("N" + str).Value = kvz  
       Range("Q" + str).Value = dkvz  
       Range("T" + str).Value = nomenklat  
       Range("AB" + str).Value = naimenov  
       Range("AR" + str).Value = izm  
       Range("BE" + str).Value = cena  
   End With  
 
TextBox5.Text = ""  
   CommandButton4.Enabled = False  
End Sub  
 
Все работало отлично, но на утро перестало. Может что накосячил полусонный но немогу найти где. Подскажите плиз?..

Добрый вечер. Есть таблица, в одном из столбцов вводится дата в формате "12.янв" и так целый месяц и каждый месяц. Подскажите как можно используя автофильтр отфильтровать значения по месяцу, т.е. по какому месяцу фильтровать данные брались из ячейки L5.

Добрый день. Есть таблица (оборотка), в столбце В имеются номенклатурный номер материала. Необходимо выполнить поиск одинаковых номенклатурных номеров и если таковые имеются то сложить ячейки в столбце М (количество), после чего удалить последующие строки с таким номенклатурным номером. Т.е. если например имеется 5 ячеек с одинаковым значением в столбике В (номенклатурный номенр)и значением в столбце М (количество) 2,5,4,1,3, то после выполнения макроса должно получится одна строка с номенклатурным номером в ячейке В и в ячейке М значение 15 (сумма значений счеек в столбце М) а остальные 4 строки удалены.

{quote}{login=Hugo}{date=13.10.2011 01:43}{thema=}{post}Х{/post}{/quote}  
 
Спасибо, все работает правильно. Hugo ты молодец.

Добрый вечер. Есть документ txt в котором таблица с фиксированной шириной. Необходимо его сохранить в xls, ручками все получается без проблем а вот с помощью макроса не получается. Выкладываю примеры. Подскажите как это сделать автоматически.

Спасибо,все работает. Тема закрыта.

Спасибо все работает. Но вызникает новый вопрос как это:  
{quote}{login=}{date=12.10.2011 01:31}{thema=}{post}в модуль книги:  
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  
   If Not progsaving Then Cancel = True  
End Sub  
 
в стандартный модуль:  
 
Public progsaving As Boolean  
 
Sub макрос_сохранения()  
   progsaving = True  
   ...  
   ...saveas  
   progsaving = False  
End Sub{/post}{/quote}  
 
удалить из сохраненного файла, т.е. макрос должен быть только в шаблоне?