-1

我有一个选择特定列来创建图表的 VBA。我遇到了一个问题，即图表中会省略某些列，我不知道为什么。故障排除后，我发现一旦将省略的列从 Text 转换为 Column，它们就可以工作了。知道为什么吗？

我尝试使用 VBA 将每一列从 Text 转换为 Column 但出现错误

...一次只能转换一列...

一次做一个将永远花费我的时间，因为我有数百个专栏要做。有没有可以快速处理这个的VBA？

如果有帮助，这是我创建图表的代码：

Sub Graph2()

'   Graphs for monitoring

    Dim my_range As Range, t, co As Shape 

    t = Selection.Cells(1, 1).Value & " - " & ActiveSheet.Name

    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet

    Set my_range = Union(Selection, ActiveSheet.Range("A:A"))

    Set co = ActiveSheet.Shapes.AddChart2(201, xlLine) 'add a ChartObject

    With co.Chart
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .SetSourceData Source:=my_range
        'highlight final dot of data
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count - 1).ApplyDataLabels Type:=xlShowValue
        .HasTitle = True
        .ChartTitle.Text = t
        'ResolveSeriesnames co.Chart
        .Location Where:=xlLocationAsObject, Name:="Graphs"

    End With

    OldSheet.Activate
End Sub
4

1 回答 1

0

这是我的答案。

目的：获取列的列表，并尽可能快地一一
应用该方法。Range.TextToColumns

算法：
1. 创建所需列的数组；
2. 逐列遍历这个数组：
- 2.1 检查右边是否有数据；
- 2.2 确保在右侧插入足够的列以保留数据；
- 2.3 应用Range.TextToColumns方法。

测试对象：
200 行和 200 列的范围内填充了"Sample Data"文本和随机插入的"Sample Data Data Data Data Data"文本，以使用不同的分隔符数量进行测试。使用空间作为分隔符：
样本

代码： 

Sub SplitColumns()
Dim rToSplit() As Range, r As Range
Dim i As Long, j As Long, k As Long
Dim sht As Worksheet
Dim delimiter As String
Dim consDelimiter As Boolean
Dim start As Single, total As Single
Dim delimitersCount() As Long

'========================== TESTING STUFF =======================================
' set working sheet
Set sht = ThisWorkbook.Sheets("Sheet2")

' re-create sample data (it is changed on each macro run)
sht.Cells.Clear
ThisWorkbook.Sheets("Sheet2").Cells.Copy Destination:=sht.Cells(1, 1)

' timer for testing purposes - start point
start = Timer
'======================== END OF TESTING STUFF ===================================

' Set the delimiter
' I've used space
delimiter = " "

' assign a ConsecutiveDelimiter state
consDelimiter = False

Application.ScreenUpdating = False

'=================== CREATING A LIST OF COLUMNS FOR SPLIT ========================
' create an array of columns to be changed
' at this sample I take all 200 columns
' you have to assign your own range which is to be splitted
With sht
    For i = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
        ' add columns to an array
        If Not .Cells(1, i) = "" Then
            ReDim Preserve rToSplit(j)
            Set rToSplit(j) = Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp))
            j = j + 1
        End If
    Next
End With
'=============== END OF CREATING A LIST OF COLUMNS FOR SPLIT ======================




'============================= PERFORMING SPLIT ===================================
' go through each column in array
' from left to right, because
' there may be a need to insert columns
For j = LBound(rToSplit) To UBound(rToSplit)

    ' check whether there is any data on the right from the top cell of column
    ' note - I'm checking only ONE cell
    If Not rToSplit(j).Cells(1, 1).Offset(0, 1) = "" Then
        ' creating another array:
        ' purpose - check cells in column
        ' and count quantity of delimiters in each of them
        ' quantity of delimiters = quantity of columns to insert
        ' in order not to overwrite data on the right
        For Each r In rToSplit(j).Cells
            ReDim Preserve delimitersCount(k)
            delimitersCount(k) = UBound(Split(r.Text, delimiter))
            k = k + 1
        Next

        ' get the maximun number of delimiters (= columns to insert)
        For i = 1 To WorksheetFunction.Max(delimitersCount)
            ' and insert this quantity of columns
            rToSplit(j).Cells(1, 1).Offset(0, 1).EntireColumn.Insert
        Next

        ' split the column, nothing will be replaced
        rToSplit(j).TextToColumns Destination:=rToSplit(j).Cells(1, 1), ConsecutiveDelimiter:=consDelimiter, Tab:=False, Semicolon:=False, Comma:=False, _
                                                                        Space:=False, Other:=True, OtherChar:=delimiter
    Else
        ' here I just split column as there is no data to the right
        rToSplit(j).TextToColumns Destination:=rToSplit(j).Cells(1, 1), ConsecutiveDelimiter:=consDelimiter, Tab:=False, Semicolon:=False, Comma:=False, _
                                                                        Space:=False, Other:=True, OtherChar:=delimiter
    End If
    ' clear the delimiters count array
    Erase delimitersCount
' go to next column
Next

' done
'========================= END OF PERFORMING SPLIT ===================================

' timer for testing purposes - time difference in seconds
total = Timer - start

Debug.Print "Total time spent " & total & " seconds."

Application.ScreenUpdating = True
End Sub

希望有帮助。

于 2020-01-28T10:32:40.923 回答