DenSyo
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
JekaKot
Код: Sub WriteSERVICE()
Dim filesDict As Object, valDict As Object
Dim j As Long, n As Long
Dim s As String, ss As String
Dim f As Variant
Set wsUnload = ActiveSheet
Set filesDict = CreateObject("Scripting.Dictionary")
Set valDict = CreateObject("Scripting.Dictionary")
If wsUnload.Cells(wsUnload.Rows.Count, 14).Value <> "" Then n = wsUnload.Rows.Count Else n = wsUnload.Cells(wsUnload.Rows.Count, 14).End(xlUp).Row
For j = 3 To n
If Not filesDict.Exists(wsUnload.Cells(j, 14).Value) Then filesDict.Add wsUnload.Cells(j, 14).Value, wsUnload.Cells(j, 14).Value
Next j
For Each f In filesDict.Items
s = ""
For j = 3 To n
If wsUnload.Cells(j, 14).Value = f And Not valDict.Exists(wsUnload.Cells(j, 8).Value) Then
valDict.Add wsUnload.Cells(j, 8).Value, wsUnload.Cells(j, 8).Value
s = s & "[InstanceData]" & vbCrLf & "SERVICE=" & wsUnload.Cells(j, 8).Value & vbCrLf & vbCrLf
End If
Next j
ss = ThisWorkbook.Path & Application.PathSeparator & f & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
Open ss For Output As #1
Print #1, s
Close #1
valDict.RemoveAll
Next
End Sub |
более производительная версия:
Код: Sub WriteSERVICE2()
Dim filesDict As Object
Dim j As Long, n As Long
Dim ss As String
Dim f As Variant
Set wsUnload = ActiveSheet
Set filesDict = CreateObject("Scripting.Dictionary")
If wsUnload.Cells(wsUnload.Rows.Count, 14).Value <> "" Then n = wsUnload.Rows.Count Else n = wsUnload.Cells(wsUnload.Rows.Count, 14).End(xlUp).Row
For j = 3 To n
If Not filesDict.Exists(wsUnload.Cells(j, 14).Value) Then
filesDict.Add wsUnload.Cells(j, 14).Value, "[InstanceData]" & vbCrLf & "SERVICE=" & wsUnload.Cells(j, 8).Value & vbCrLf & vbCrLf
Else
If Not filesDict.Item(wsUnload.Cells(j, 14).Value) Like "*SERVICE=" & wsUnload.Cells(j, 8).Value & "*" Then filesDict.Item(wsUnload.Cells(j, 14).Value) = filesDict.Item(wsUnload.Cells(j, 14).Value) & "[InstanceData]" & vbCrLf & "SERVICE=" & wsUnload.Cells(j, 8).Value & vbCrLf & vbCrLf
End If
Next j
For Each f In filesDict.Keys
ss = ThisWorkbook.Path & Application.PathSeparator & f & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
Open ss For Output As #1
Print #1, filesDict.Item(f)
Close #1
Next
End Sub |
|
Всего записей: 219 | Зарегистр. 19-01-2008 | Отправлено: 05:11 12-12-2019 | Исправлено: DenSyo, 05:42 12-12-2019 |
|
