How to replicate a value depending on what is inside the cell?

Navigation
0

I have a code that always puts 264 empty characters after the last word entered inside the cell; then puts more "00000000000000" after the 264 empty characters and I export to txt, as I show below:

MyquestionisdoIhavetoputattheendofthelineafterthe264charactersalways"99999999999999" that in the cell has the following field filled in: 5497558138889999999999998

Follow my code: 

Sub Macro14()

Application.ScreenUpdating = False

Dim arq1 As Long
Dim name As String
Dim op As Variant
Dim linha As Long
Dim res As String

On Error GoTo fim:

linha = 1

While ThisWorkbook.Sheets("TesteConcluido").Cells(linha, 1) <> ""

name = ThisWorkbook.Sheets("TesteConcluido").Cells(linha, 1)

While Len(name) < 265

name = name + " "

Wend


If linha = 42 And 43 Then

name = name & "999999999990000"

Else

name = name & "000000000000000"

End If

arq1 = FreeFile

Open fileTeste For Append As arq1

Print #arq1, name

Close #arq1
linha = linha + 1
Wend

fim:
If Err.Number = "70" Then

Resume

End If

MsgBox "O arquivo foi exportado com sucesso! ", vbInformation, "Exportar arquivos"

res = MsgBox("Você gostaria voltar ao menu?", vbYesNo + vbQuestion, "QNIS - CAIXA")

If res = vbYes Then

Else

ThisWorkbook.Close savechanges:=True
Unload FormQNIS
End If

Application.ScreenUpdating = True


End Sub
    
asked by anonymous 20.11.2017 / 15:58

1 answer

0

Here is a solution to the problem: 

Option Explicit

Sub Macro14()

Application.ScreenUpdating = False

Dim arq1 As Long
Dim name As String
Dim op As Variant
Dim linha As Long
Dim res As String
Dim texto As String

texto = "54975581388899999999999"


On Error GoTo fim:
    
linha = 1

While ThisWorkbook.Sheets("TesteConcluido").Cells(linha, 1) <> ""
     
name = CStr(ThisWorkbook.Sheets("TesteConcluido").Cells(linha, 1).Value)
    
While Len(name) < 265
            
name = name + " "
            
Wend

If InStr(1, name, texto, vbTextCompare) > 0 Then

name = name & "999999999990000"

Else

name = name & "000000000000000"

End If
       
arq1 = FreeFile

Open fileTeste For Append As arq1

Print #arq1, name

Close #arq1
linha = linha + 1
Wend

fim:
If Err.Number = "70" Then

Resume

End If

MsgBox "O arquivo foi exportado com sucesso! ", vbInformation, "Exportar arquivos"

res = MsgBox("Você gostaria voltar ao menu?", vbYesNo + vbQuestion, "QNIS - CAIXA")
    
If res = vbYes Then
  
Else

ThisWorkbook.Close savechanges:=True
Unload FormQNIS
End If

Application.ScreenUpdating = True


End Sub
    
23.11.2017 / 13:58
Laravel - RESTful API SQL developer user and password