如何从单元格中提取数据并按字母顺序排列单元格?

时间:2015-12-02 09:41:13

标签: excel vba excel-vba

我正在尝试自动化excel修改。

这个过程是这样的:

  1. 创建Excel列表。
  2. 需要员工手动处理(删除图像,按字母顺序排序等)
  3. 该列表将转换为csv文件。
  4. CSV上传和处理。
  5. 现在我想尽可能地自动化这个过程。我没有使用VBA或Excel宏的经验。

    到目前为止,我已经能够将几个不同的脚本拼凑起来中途,但我无法使这两个功能正常工作。 我已经能够删除顶部的所有膨胀(不是在底部),删除空行并删除未使用的列。

    由于隐私原因,我无法发布工作表本身的内容,但工作表的结构如下所示:

    | Name | Cost |
    
    | Mark Renner (mare) | €200,- |
    

    问题

    我想提取4个字母的代码并将其替换为全名,因此只有4个字母代码保留在单元格中。

    此外,我希望按字母顺序对列表进行排序。片材的范围每天不同,因此没有固定的细胞数量。

    您需要担心的工作表上没有其他内容。如有必要,我可以提供更多信息。

    如果有人能够帮助我,那将是巨大的。

    提前致谢!

    编辑:

    以下是一些更多要求的信息。

    Table example after current script

    这是我目前用来删除所有臃肿的脚本。我确信它并不完美,但它现在可以完成这项任务。

    
        Sub run()
        Call testvba
        Call DeleteRowWithContents
        Call usedR
        End Sub
    
        Sub testvba()
        Dim i As Integer
        For i = 1 To 21
        Rows(1).EntireRow.Delete
        Next i
    
        For i = 1 To 10
        Columns(4).EntireColumn.Delete
        Next i
    
        Dim shape As Excel.shape
        For Each shape In ActiveSheet.Shapes
        shape.Delete
        Next
    
    
        End Sub
    
        Sub DeleteRowWithContents()
        Last = Cells(Rows.Count, "A").End(xlUp).Row
        For i = Last To 1 Step -1
            If (Cells(i, "A").Value) = "User" Then
                Cells(i, "A").EntireRow.Delete
            End If
        Next i
        End Sub
    
        Sub usedR()
        ActiveSheet.UsedRange.Select
        'Deletes the entire row within the selection if the ENTIRE row contains no      data.
        Dim i As Long
        'Turn off calculation and screenupdating to speed up the macro.
        With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        'Work backwards because we are deleting rows.
        For i = Selection.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
        Selection.Rows(i).EntireRow.Delete
        End If
        Next i
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        End With
        End Sub `
    

    以下是脚本之前的表格:

    Before

    SOLUTION:

    我使用Schalton的代码来提取4个字母的代码。

    我最终使用这行代码按字母顺序排列记录:

    
        Sub Alpha()
        Dim fromRow As Integer
        Dim toRow As Integer
        fromRow = 1
        toRow = ActiveSheet.UsedRange.Rows.Count
            ActiveSheet.Rows(fromRow & ":" & toRow).Sort Key1:=ActiveSheet.Range("A:A"), _
               Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
               MatchCase:=False, Orientation:=xlTopToBottom
        End Sub
    

1 个答案:

答案 0 :(得分:0)

要获得4个字母的代码,您可以搜索"("并剪切字符串

这样的东西会让你获得代码,你可以使用regedit但这看起来有点矫枉过正

Sub ReplaceName()
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For r = 2 to LastRow 'assumes data starts in row 2 with header in row 1
    if Cells(r,1).value = "" then goto Nextr 'skips blanks
    CurrentString = Cells(r,1).value 'assumes the names are in column 1
    'At this point CurrentString = "Mark Renner (mare)"
    CurrentString = Right(CurrentString,len(CurrentString)-instr(1,CurrentString,"("))
    'At this point CurrentString = "mare)"
    CurrentString = left(CurrentString,instr(1,CurrentString,")")-1)
    'At this point CurrentString = "mare"
    Cells(r,1).value = CurrentString
Nextr:
Next r
End Sub

至于按字母顺序排列,有两种方法可以想到

  1. 将所有值移动到数组中,然后遍历数组并对其进行排序
  2. 创建过滤范围,过滤器
  3. 第二个选项更容易,对于你正在做的事情,我认为它可能很好。它看起来像这样:

    使用如下所示的数据(在单元格A1到B6中):

    Name    Cost
    Tom     149
    Dick    272
    Harry   186
    Moe     292
    Larry   377
    

    我做这样的事情:

    Sub SortAlpha()
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Range(Cells(1,1),Cells(LastRow,2)).select 'selects the data and headers
    Selection.AutoFilter 'Adds Filter
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Clear
    
    Range(Cells(1, 1), Cells(LastRow, 1)).Select 'selects name column
    
    'filters alpha
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Selection _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range(Cells(1,1),Cells(LastRow,2)).select 'selects the data and headers
    Selection.AutoFilter 'Removes Filter
    End Sub
    

    那会给你这个:

    Name    Cost
    Dick    272
    Harry   186
    Lary    377
    Moe     292
    Tom     149
    

    就清理数据而言,当我的数据表非常混乱时,我通常会做一些事情

    从这里开始:

     1. iterate through the range and remove all merges
     2. unwrap all of the text
     3. delete all pictures
     4. Delete any blank Rows or columns
    

    我喜欢这段代码来查找最后一行:

    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    

    您可以修改它以查找最后一列

    LastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    

    然后,您可以按单元格或作为范围循环遍历整个工作表单元格 Cell by Cell :(我用这个来解开细胞 - 可能很慢)

    For r = 1 to LastRow
        For c = 1 to LastCol
           'Do Stuff
           Cells(r,c).UnMerge 'or Cells(r,c).MergeCells = False
        Next c
    Next r
    

    或作为范围:我用它来展开文本

    Range(Cells(1,1),Cells(LastRow,LastCol)).WrapText = False
    

    要删除图片我使用此代码: Deleting pictures with Excel VBA

    Dim shape As Excel.shape
    For Each shape In ActiveSheet.Shapes
        shape.Delete
    Next
    

    如果您想要自动执行此操作,这似乎可以用于保存csv:

    Saving excel worksheet to CSV files with filename+worksheet name using VB

    我会重新调整所有行和列的行,将行重新调整为默认值,将列重新调整为适合度: 不幸的是,我没有找到一个很好的方法来做没有范围字符串的行,所以我的代码有点乱:

    RowRange = "1:" & LastRow
    Rows(RowRange).RowHeight = 12.75
    

    列大致相同,但更糟糕的是因为它们没有编号

    ColStart = Cells(1,1).Address
    ColEnd = Cells(1,LastCol).Address
    ColStart = left(ColStart,len(ColStart)-1)
    ColEnd = left(ColEnd,len(ColEnd)-1)
    ColStart = Replace(ColStart,"$","")
    ColEnd = Replace(ColEnd,"$","")
    ColRange = ColStart & ":" & ColEnd
    Columns(ColRange).EntireColumn.AutoFit
    

    你也可以把它变得非常大,但那里的乐趣在哪里?

    Columns("A:ZZ").EntireColumn.AutoFit