2010

a_axe · Конфигурация компьютера

golovatov, насколько я понимаю - вы хотите скопировать каждую столько раз, сколько написано в ячейке второго столбца на каждой строчке?

Цитата golovatov:

в итоге должно получиться 2577473 »

2577473 - это сумма всех значений по столбцу 2, верно?
попробуйте такой код, оговорки - во втором столбце должна обязательно стоять цифра (иначе строчка будет пропущена), значение в txt файле разделяются знаком ";", конечный файл сохраняется по адресу "C:/1.txt". Полностью вашу таблицу не прогонял - стало скучно когда txt файл весил около 145мБт.

код

Код:

Public Sub xls_to_txt()

Dim DataCell As Range
Dim DataSheet As Worksheet
Dim i As Long
Set FSO = CreateObject("scripting.filesystemobject")
Set ts = FSO.CreateTextFile("C:/1.txt", True, True)

Set DataSheet = ActiveSheet

For Each DataCell In Intersect(DataSheet.UsedRange, DataSheet.Columns(1))

    If IsNumeric(DataCell.Offset(0, 1).Value) Then
    
        For i = 1 To DataCell.Offset(0, 1).Value
            ts.Write Trim(DataCell.Value & ";")
            ts.Write Trim(DataCell.Offset(0, 1).Value & ";")
            ts.Write Trim(DataCell.Offset(0, 2).Value & Chr(13))
        Next i
        
        
    End If
Next DataCell
ts.Close
Set ts = Nothing
Set DataSheet = Nothing
Set FSO = Nothing
Set DataCell = Nothing
End Sub

golovatov, а Вы уверены, что Вам нужно именно это? Проблему этим копированием Вы какую решаете?

golovatov · Отправлено: **18:08, 12-11-2015** | #3

Цитата a_axe:

насколько я понимаю - вы хотите скопировать каждую столько раз, сколько написано в ячейке второго столбца на каждой строчке? »

верно

Цитата a_axe:

2577473 - это сумма всех значений по столбцу 2, верно? »

да

а можно сделать ,чтобы сами строчки не двоились, как на рисунке
а было просто
01.01.2013;25;30,37

golovatov · Отправлено: **18:14, 12-11-2015** | #4

а тут видите
01.01.2013;25;30,3701.01.2013;25;30,37.

они встолбик должны идти
вот так
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
01.01.2013;25;30,37
02.01.2013;2957;30,37

a_axe · Конфигурация компьютера

в коде замените Chr(13) на точку с запятой в кавычках - чтоб было так же, как в конце строчки на одну выше.

golovatov · Отправлено: **18:47, 12-11-2015** | #6

что-то не помогло, я сделал как Вы сказали
ts.Write Trim(DataCell.Offset(0, 2).Value & ";")
но вот результат
теперь тут 3333 строки в csv файле, и все значения не в столбиках

a_axe · Конфигурация компьютера

golovatov, до того как вы отредактировали свой пост было непонятно, что вы имеете ввиду.
У меня изначально результат виден столбиком.
Поставьте бесплатный продвинутый аналог блокнота AkelPad и откройте через него, используя первоначальный код.

golovatov · Отправлено: **12:34, 13-11-2015** | #8

Да с этим блокнотом все хорошо, но почему штатный блокнот не работает? В любом случае, Вы очень выручили.

golovatov · Отправлено: **14:43, 13-11-2015** | #9

Только вот он дублирует строки только для одной переменной. у меня их 2
дата.кол-во, var1 и var2
я получаю на выходе
дата.кол-во, var1

a_axe · Конфигурация компьютера

Цитата golovatov:

значение переменной (их там будет var1,var2,var3) »

В самом деле, этот момент я изначально упустил из виду. Код изменится вот так (количество переменных теперь любое):

Код

Код:

Public Sub xls_used_to_txt()

Dim DataCell As Range
Dim DataSheet As Worksheet
Dim i As Long, n As Integer, j As Integer
Set FSO = CreateObject("scripting.filesystemobject")
Set ts = FSO.CreateTextFile("C:/1.txt", True, True)

Set DataSheet = ActiveSheet
n = DataSheet.UsedRange.Columns.Count - 1

For Each DataCell In Intersect(DataSheet.UsedRange, DataSheet.Columns(1))

    If IsNumeric(DataCell.Offset(0, 1).Value) Then
    
        For i = 1 To DataCell.Offset(0, 1).Value
            ts.Write Trim(DataCell.Value & ";")
                For j = 1 To n
                    ts.Write Trim(DataCell.Offset(0, j).Value & ";")
                Next j
            ts.Write Trim(Chr(13))
        Next i
        
        
    End If
Next DataCell
ts.Close
Set ts = Nothing
Set DataSheet = Nothing
Set FSO = Nothing
Set DataCell = Nothing
End Sub