VBA не будет работать на ячейках, если не преобразован из текста в столбцы

Question

У меня есть VBA, который выбирает определенные c столбцы для создания диаграммы. У меня возникла проблема, когда некоторые столбцы были бы опущены в диаграмме, и я не знал, почему. После устранения неполадок я обнаружил, что как только пропущенные столбцы были преобразованы из текста в столбец, они работали. Есть идеи почему?

Я пытался преобразовать каждый столбец из текста в столбец с помощью VBA, но я получаю сообщение об ошибке

... можно преобразовать только один столбец за раз ...

Выполнение по одному заняло бы бесконечно, поскольку у меня есть сотни столбцов. Есть ли 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

Answer 1

Вот мой ответ.

Цель:
Возьмите список столбцов и примените метод Range.TextToColumns один за другим как можно быстрее.

Алгоритм:
1. Создайте массив необходимых столбцов;
2. Go через этот массив столбец за столбцом и:
- 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

Надеюсь, что поможет.