Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

19th
Мар

Работа с файлом через макросы (Microsoft Office Excel)

Posted by obzor under Basic, VBA, Софт

Суть вопроса такова, имеется .txt файл, его нужно открыть в exel указав путь к нему. Далее его необходимо отредактировать так, чтобы все текстовые и пустые строки были удалены. А данные из столбца в который все вставилось расформировались в отдельные. Так же необходимо чтобы строки с одинаковыми значениями в стоблцах B,C,D были удалены(одна из двух осталась).

IgorGO

Sub TxtRasKolbas()
  Dim fn, rg As Range, rgD As Range, r As Long
  fn = Application.GetOpenFilename("Txt files, *.txt", 1, "Укажите файл", MultiSelect:=False)
  If fn = False Then Exit Sub
  Workbooks.Open (fn)
  ActiveSheet.UsedRange.Offset(, 1).FormulaR1C1 = "=trim(rc1)"
  ActiveSheet.UsedRange.Copy: Cells(1, 1).PasteSpecial Paste:=xlPasteValues
  Columns(2).TextToColumns Cells(1, 2), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
  For Each rg In Intersect(ActiveSheet.UsedRange, Columns(2)).Cells
    If IsEmpty(rg) Or (Not IsNumeric(rg)) Then If rgD Is Nothing Then Set rgD = rg Else Set rgD = Union(rgD, rg)
  Next
  Columns(1).Delete:  If Not rgD Is Nothing Then rgD.EntireRow.Delete: r = 1
  Do While Not IsEmpty(Cells(r, 3))
    If WorksheetFunction.CountIf(Columns(3), Cells(r, 3)) > 1 Then Rows(r).Delete Else r = r + 1
  Loop
End Sub

тема на форуме