Блог

Главная - Вопросы по программированию - Отделить некоторые данные

Отделить некоторые данные

#excel #vba

#excel #vba

Вопрос:

У меня есть макрос Excel, который может разделять и сохранять файлы для каждого столбца. Моя проблема в том, что ячейки из столбца, которые я хочу разделить, не могут быть сохранены как «.xls», если в ячейке есть точка «.» в тексте.

Например: DEF. корпорация

Файл при загрузке на мой компьютер

введите описание изображения здесь

Что я должен изменить в своем коде VBA ниже, чтобы он работал?

   Dim MyFile, NewFile As Variant
  Dim sort_data As String
  Dim last_row, tfiles, start_row, ktr As Long
  
    
  'Sort data
  Range(Separate.left_column amp; Separate.last, Separate.right amp; last_row).Select
  Selection.sort Key1:=Range(Separate.sort amp; Separate.last   1), Order1:=xlAscending, Header:=True, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  
  'Initiate variable
  tfiles = 0
  
  'Loop through data
  start_row = Separate.last   1
  
  
  For ktr = Separate.last   1 To last_row
      
    'Identify data
    sort_data = Trim(UCase(Range(Separate.sort amp; start_row).Value))
    
    
    
    'End of same data
    If sort_data <> Trim(UCase(Range(Separate.sort amp; ktr).Value)) Then
      
      'Copy and paste header
      Range(Separate.left_column amp; Separate.first, Separate.right amp; Separate.last).Copy
      Workbooks.Add
      ActiveSheet.Paste
      NewFile = ActiveWorkbook.Name
      Windows(MyFile amp; "xlsx").Activate
      
      'Copy and paste data
      Range(Separate.left_column amp; start_row, Separate.right amp; ktr - 1).Copy
      Windows(NewFile).Activate
      Range(Separate.left_column amp; Separate.last   1).Select
      ActiveSheet.Paste
      
      'Bold header rows
      Rows(Separate.first).Select
      Selection.Font.Bold = True
      Range(Separate.left_column amp; last   1).Select
      
      'Auto fit
      Cells.Select
      Cells.EntireColumn.AutoFit
      Cells.EntireRow.AutoFit

      'Save workbook
      Range(Separate.left_column amp; Separate.last   1).Select
      new_file = IIf(Separate.current_file = True, MyFile amp; _
       " ", "") amp; IIf(Len(Trim(Separate.prefix)) > 0, _
       Separate.prefix amp; " ", "") amp; sort_data amp; _
       IIf(Len(Trim(Separate.suffix)) > 0, _
       " " amp; Separate.suffix, "") 'amp; "xlsx"
      ActiveWorkbook.SaveAs Filename:=new_file, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
      
      'Close workbook and return to original
      ActiveWorkbook.Close
      tfiles = tfiles   1
      start_row = ktr

Комментарии:

1. Возможно, используя Replace решение этой проблемы. Таким образом, вы можете использовать Replace(txt,".","")

2. Я предполагаю, что где-то по пути вы ищете имя файла / путь в течение определенного периода и рассматриваете все после него как расширение. Я не вижу здесь никакого Workbook.Save утверждения. Где Seperate определено?

3. Привет, ребята, пожалуйста, проверьте обновленный фрагмент кода. Спасибо!

Ответ №1:

Используйте замену, чтобы изменить вашу строковую переменную new_file на символ подчеркивания _ или что-то в этом роде. Подчеркивание является одним из лучших вариантов, поскольку оно позволяет дважды щелкнуть полное имя файла (вместо использования тире) и обычно принимается веб-сайтами и другими системами размещения файлов.

Просто добавьте строку ниже перед вашей ActiveWorkbook.SaveAs процедурой.

 new_file = replace(new_file,".","_")