Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск определенного значения и вставка его в нужную ячейку - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск определенного значения и вставка его в нужную ячейку (Макросы/Sub)
Поиск определенного значения и вставка его в нужную ячейку
polarman Дата: Вторник, 24.07.2018, 13:17 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте! Хочу обратиться к Вам за помощью. Помогите дописать макрос или может можно формулу поставить. Проблема такая. Есть файлы с метеоданными, так называемые ЛОГ-и. Из этих данных при помощи макроса импортируются в excel определенные строки. В столбце "H" значения скорости ветра. В некоторых эти значения равны «0»т.е. штиль. Однако при этом в столбце "М" стоит направление ветра к примеру 77 градусов(флюгер застыл при штиле в этом положении). Возможно ли сделать так чтоб при нулевой скорости ветра значения направления ветра были тоже нулевыми. Т.е. если в столбце "Н" будет встречаться ноль, то и в этой же строке в столбце "М" программа переписывала бы значение на нулевое. И еще можно ли чтоб программа загружала данные не с первой строки, а с 4-ой. Все файлы в прилагаемом архиве. Буду очень признателен и благодарен!

[vba]
Код

Sub Январь_Скругленныйпрямоугольник1_Щелчок()
Dim y1 As Long, y As Long, x, Filename, fso As Object, a$()
  On Error Resume Next

  ' задаём стартовую папку
  ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path

  ' вывод диалогового окна для запроса имени сохраняемого файла
  Filename = Application.GetOpenFilename("Text files (*.met),", , "Открыть файл для обработки", "Load data", True)

  ' если пользователь отказался от выбора  файла - отменяем загрузку данных
  If VarType(Filename) = vbBoolean Then Exit Sub

  Set fso = CreateObject("Scripting.FileSystemObject")
  With Worksheets("Январь")
    y = .Cells(.Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
    y1 = y
    For Each x In Filename
      a = Split(fso.OpenTextFile(x).ReadAll, vbNewLine)
      .Cells(y, 2).Resize(8).Value = WorksheetFunction.Transpose( _
          Array(a(180), a(360), a(540), a(720), a(900), a(1080), a(1260), a(1440)))
      .Cells(y, 1).Resize(8).Value = CDate(a(0))
      y = y + 8
    Next
    With .Range("B" & y1 & ":B" & y)
      .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 2), _
        Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 1), Array(13, 1 _
        ), Array(14, 1)), TrailingMinusNumbers:=True
      .Copy
      .Offset(, -1).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
      .Delete xlShiftToLeft
    End With
    With .Range("B" & y1 & ":J" & y)
      .NumberFormat = "General"
      .Replace What:=".", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
  End With
End Sub
[/vba]
К сообщению приложен файл: 0811723.rar(45.0 Kb) · Arhiv2.rar(97.6 Kb)


Сообщение отредактировал polarman - Вторник, 24.07.2018, 13:26
 
Ответить
СообщениеЗдравствуйте! Хочу обратиться к Вам за помощью. Помогите дописать макрос или может можно формулу поставить. Проблема такая. Есть файлы с метеоданными, так называемые ЛОГ-и. Из этих данных при помощи макроса импортируются в excel определенные строки. В столбце "H" значения скорости ветра. В некоторых эти значения равны «0»т.е. штиль. Однако при этом в столбце "М" стоит направление ветра к примеру 77 градусов(флюгер застыл при штиле в этом положении). Возможно ли сделать так чтоб при нулевой скорости ветра значения направления ветра были тоже нулевыми. Т.е. если в столбце "Н" будет встречаться ноль, то и в этой же строке в столбце "М" программа переписывала бы значение на нулевое. И еще можно ли чтоб программа загружала данные не с первой строки, а с 4-ой. Все файлы в прилагаемом архиве. Буду очень признателен и благодарен!

[vba]
Код

Sub Январь_Скругленныйпрямоугольник1_Щелчок()
Dim y1 As Long, y As Long, x, Filename, fso As Object, a$()
  On Error Resume Next

  ' задаём стартовую папку
  ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path

  ' вывод диалогового окна для запроса имени сохраняемого файла
  Filename = Application.GetOpenFilename("Text files (*.met),", , "Открыть файл для обработки", "Load data", True)

  ' если пользователь отказался от выбора  файла - отменяем загрузку данных
  If VarType(Filename) = vbBoolean Then Exit Sub

  Set fso = CreateObject("Scripting.FileSystemObject")
  With Worksheets("Январь")
    y = .Cells(.Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
    y1 = y
    For Each x In Filename
      a = Split(fso.OpenTextFile(x).ReadAll, vbNewLine)
      .Cells(y, 2).Resize(8).Value = WorksheetFunction.Transpose( _
          Array(a(180), a(360), a(540), a(720), a(900), a(1080), a(1260), a(1440)))
      .Cells(y, 1).Resize(8).Value = CDate(a(0))
      y = y + 8
    Next
    With .Range("B" & y1 & ":B" & y)
      .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 2), _
        Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 1), Array(13, 1 _
        ), Array(14, 1)), TrailingMinusNumbers:=True
      .Copy
      .Offset(, -1).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
      .Delete xlShiftToLeft
    End With
    With .Range("B" & y1 & ":J" & y)
      .NumberFormat = "General"
      .Replace What:=".", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
  End With
End Sub
[/vba]

Автор - polarman
Дата добавления - 24.07.2018 в 13:17
Manyasha Дата: Вторник, 24.07.2018, 13:56 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2193
Репутация: 892 ±
Замечаний: 0% ±

Excel 2010, 2016
polarman, для нулей, добавьте в конец макроса:
[vba]
Код
    For i = y1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(i, "h") = 0 Then .Cells(i, "m") = 0
    Next i
[/vba]
чтоб программа загружала данные не с первой строки, а с 4-ой.

[vba]
Код
    If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
    If y = 1 Then y = 4 'Добавить
[/vba]и[vba]
Код
Sub Очистить_Январь()
'
' Очистить_Январь Макрос

    Range([a4], [a4].End(xlDown).End(xlToRight)).ClearContents
End Sub
[/vba]
У Вас на каждый месяц отдельный макрос?
Можно вместо [vba]
Код
With Worksheets("Январь")
[/vba] написать
[vba]
Код
With Activesheet
[/vba]или вообще убрать этот with и стереть точки перед cells, range и т.д.
Тогда будет один макрос для любого месяца


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеpolarman, для нулей, добавьте в конец макроса:
[vba]
Код
    For i = y1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(i, "h") = 0 Then .Cells(i, "m") = 0
    Next i
[/vba]
чтоб программа загружала данные не с первой строки, а с 4-ой.

[vba]
Код
    If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
    If y = 1 Then y = 4 'Добавить
[/vba]и[vba]
Код
Sub Очистить_Январь()
'
' Очистить_Январь Макрос

    Range([a4], [a4].End(xlDown).End(xlToRight)).ClearContents
End Sub
[/vba]
У Вас на каждый месяц отдельный макрос?
Можно вместо [vba]
Код
With Worksheets("Январь")
[/vba] написать
[vba]
Код
With Activesheet
[/vba]или вообще убрать этот with и стереть точки перед cells, range и т.д.
Тогда будет один макрос для любого месяца

Автор - Manyasha
Дата добавления - 24.07.2018 в 13:56
polarman Дата: Вторник, 24.07.2018, 15:14 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Manyasha, Вот спасибо большое! Можно обратиться к Вам с просьбой?! Вы не могли бы как-то оформить Ваши дополнения в макросе. Поверьте, никогда бы так нагло не попросил,
просто обстоятельства вынуждают. Мы Полярники и сейчас находимся на Зимовке в Антарктиде. У компьютера накрылся жесткий диск, а с ним и похожая программа по которой работаем
все время. Теперь вот всей станцией ломаем головы как эту программу снова написать. Честно говоря мозги у всех просто опухли. Мы ведь не асы в программировании. Хорошо
интернет есть, кто-то там помог, кто то тут. Будем Вам очень благодарны!!!
 
Ответить
Сообщение Manyasha, Вот спасибо большое! Можно обратиться к Вам с просьбой?! Вы не могли бы как-то оформить Ваши дополнения в макросе. Поверьте, никогда бы так нагло не попросил,
просто обстоятельства вынуждают. Мы Полярники и сейчас находимся на Зимовке в Антарктиде. У компьютера накрылся жесткий диск, а с ним и похожая программа по которой работаем
все время. Теперь вот всей станцией ломаем головы как эту программу снова написать. Честно говоря мозги у всех просто опухли. Мы ведь не асы в программировании. Хорошо
интернет есть, кто-то там помог, кто то тут. Будем Вам очень благодарны!!!

Автор - polarman
Дата добавления - 24.07.2018 в 15:14
polarman Дата: Вторник, 24.07.2018, 17:30 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Manyasha, УРА!!! СПАСИБО! Все получилось, кроме одного. При вставке
[vba]
Код

If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
If y = 1 Then y = 4 'Добавить
[/vba]
программа не разбивает сроки на ячейки, а пишет строку в одной ячейке, хотя и опускает массив на 4-ю строчку. Что делать?


Сообщение отредактировал polarman - Вторник, 24.07.2018, 17:35
 
Ответить
Сообщение Manyasha, УРА!!! СПАСИБО! Все получилось, кроме одного. При вставке
[vba]
Код

If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
If y = 1 Then y = 4 'Добавить
[/vba]
программа не разбивает сроки на ячейки, а пишет строку в одной ячейке, хотя и опускает массив на 4-ю строчку. Что делать?

Автор - polarman
Дата добавления - 24.07.2018 в 17:30
Manyasha Дата: Вторник, 24.07.2018, 18:18 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2193
Репутация: 892 ±
Замечаний: 0% ±

Excel 2010, 2016
polarman, в этом файле работает?

Оставила 1 макрос загрузки и 1 очистки. Они общие для все листов.
Остальные все под комментами.
К сообщению приложен файл: polarman-1.xlsm(70.2 Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеpolarman, в этом файле работает?

Оставила 1 макрос загрузки и 1 очистки. Они общие для все листов.
Остальные все под комментами.

Автор - Manyasha
Дата добавления - 24.07.2018 в 18:18
polarman Дата: Среда, 25.07.2018, 17:20 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Manyasha, Еще раз огромное Вам СПАСИБО!!! Все работает!
 
Ответить
СообщениеManyasha, Еще раз огромное Вам СПАСИБО!!! Все работает!

Автор - polarman
Дата добавления - 25.07.2018 в 17:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск определенного значения и вставка его в нужную ячейку (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!