Question

嗨，我是VBA代码的初学者，但有一项工作要做：我在3列a，b，c中有数据，如果b列具有特定值，则复制整行（仅包含值的单元格）到定义路径中的文本文件。我能够创建文本文件并复制Excel数据，但是在复制到文本文件时出现错误：键入不匹配。任何帮助将不胜感激。

下面的代码当前正在使用

Sub createtextfile()     
  Dim sfilename As String
  Dim lastrow As Integer
  Dim i As Integer
  Dim range As Integer
  Dim cellvaue As range
  Dim z As range
  Dim c As range
  Dim strdata As String
  Dim strTempFile As String
  Dim ab As String
  Dim FN As Integer

  sfilename = "C:\Users\lourduraju\Desktop\telugu\abc.txt"
  lastrow = Worksheets("Sheet1").UsedRange.Rows.Count

  For i = 2 To lastrow
    cellvalue = Worksheets("Sheet1").Cells(i, "B").Value

  If cellvalue = 22 Then
    'copycells
    FN = FreeFile
    Open sfilename For Output As #FN

    ab = Worksheets("Sheet1").Rows(i).Value

    Print #FN, ab
  Else
  End If
  Next
End Sub

Answer 1

首先，我建议您始终在模块顶部包含spec: concurrencyPolicy: Forbid failedJobsHistoryLimit: 1 jobTemplate: metadata: creationTimestamp: null spec: [ADD THIS -->]backoffLimit: 0 template: ... MORE STUFF ...语句。这将强制进行变量的显式声明，并且可能会捕获您的一个错误-在声明Option Explicit时出现拼写错误。

如VinhCC所述，由于cellvalue被分配了一个值，因此应将其声明为cellvalue，而不是Variant。

看看下面的代码，这些代码已根据您的最后指示进行了重写...

Range

修改

要将第一列的格式设置为7位数字，请在Application.Index ...之后添加以下行。

Option Explicit

Sub CreateTextFiles()

    Dim vData As Variant
    Dim vRow As Variant
    Dim vFileNumbers As Variant
    Dim sPath As String
    Dim sFilename As String
    Dim sText As String
    Dim iFileNum As Integer
    Dim LastRow As Long
    Dim i As Long
    Dim j As Long

    sPath = "C:\Users\lourduraju\Desktop\telugu\"
    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If

    vData = Worksheets("Sheet1").UsedRange.Value

    vFileNumbers = Array(22, 25, 33, 36) 'add other numbers as desired

    For i = LBound(vFileNumbers) To UBound(vFileNumbers)
        sFilename = sPath & "abc" & vFileNumbers(i) & ".txt"
        iFileNum = FreeFile()
        Open sFilename For Output As #iFileNum
            For j = 2 To UBound(vData) 'start at the second row of data
                If vData(j, 2) = vFileNumbers(i) Then
                    vRow = Application.Index(vData, j, 0)
                    sText = Join(vRow, "")
                    Print #iFileNum, sText
                End If
            Next j
        Close #iFileNum
    Next i

End Sub

Answer 2

我认为手机可能是变体

Sub createtextfile()     
  Dim sfilename As String
  Dim lastrow As Integer
  Dim i As Integer
  Dim range As Integer
  Dim cellvaue ' As range   <<- It should be Variant 
  Dim z As range
  Dim c As range
  Dim strdata As String
  Dim strTempFile As String
  Dim ab As String
  Dim FN As Integer

  sfilename = "C:\Users\lourduraju\Desktop\telugu\abc.txt"
  lastrow = Worksheets("Sheet1").UsedRange.Rows.Count

  For i = 2 To lastrow
      cellvalue = Worksheets("Sheet1").Cells(i, "B").Value

      If cellvalue = 22 Then
        'copycells
        FN = FreeFile
        Open sfilename For Output As #FN

        ab = Worksheets("Sheet1").Rows(i).Value

        Print #FN, ab
      Else
      End If
  Next
End Sub

Answer 3

Sub EXPORTAR_TXT_ANCHOFIJO()
Dim i As Double
'Creamos autom?ticamente un .txt en blanco que llamamos EJEMPLO
'el archivo se crear? en la misma unidad que tenemos el Excel.
Archivo_txt = ThisWorkbook.Path & "\" & "EJEMPLO.txt"
'si queremos cambiar su ubicaci?n basta con poner Archivo_txt = "E:\EJEMPLO.txt"
Open Archivo_txt For Output As #1

With Sheets(1)
fin = Application.CountA(Range("A:A"))

For i = 2 To fin
'Asignamos a cada Campo la funci?n que necesitamos aplicar
Campo1 = C_Der(.Cells(i, 1), 20)
Campo2 = C_Der(.Cells(i, 2), 23)
Campo3 = C_Der(.Cells(i, 3), 28)
Campo4 = C_Izq(.Cells(i, 4), 4)

Print #1, Campo1 & Campo2 & Campo3 & Campo4

Next i

Close
End With
End Sub


Function C_Izq(ByVal sCadena As String, ByVal nLargo As Integer, Optional sCaracter As Variant) As String

    'Creamos cadena para rellenar por la izquierda con el caracter indicado

    Dim sValor As String

    If IsMissing(sCaracter) Then sCaracter = "0"

    sCadena = Trim(sCadena)
    If Len(sCadena) > nLargo Then sCadena = Right(sCadena, nLargo)
    sValor = String(nLargo - Len(sCadena), sCaracter) & sCadena
    C_Izq = sValor

End Function
Function C_Der(ByVal sCadena As String, ByVal nLargo As Integer, Optional sCaracter As Variant) As String

    'Creamos cadena para rellenar por la derecha con el caracter indicado

    Dim sValor As String

    If IsMissing(sCaracter) Then sCaracter = Space(1)
    
    sCadena = Trim(sCadena)
    If Len(sCadena) > nLargo Then sCadena = Left(sCadena, nLargo)
    sValor = sCadena & String(nLargo - Len(sCadena), sCaracter)
    C_Der = sValor

End Function

VBA将数据导出到文本文件

3 个答案: