Question

vba提取.csv 文件中的部分数据

如题, 我想实现利用vba在我自己建立的文件.xlsm中保存.csv中某部分的数据. 我没学过vba,请高手写几段精简的代码. 万分感谢.

Answer 1

需要读取哪部分数据???
可以发东西到yf126@163.com,可以搞定
下面这个是个示例,根据需要修改
Const Title As String = "IMPORT CSV TEST"
Sub fMain()
Dim fTextDir As String
Dim pintLen As Integer
Dim pstrValue As String
Dim rowIndex As Integer
Dim i As Integer

rowIndex = 1
pstrValue = ""
pintLen = Len(Title) '标题长度
fTextDir = "D:/status.csv" ' csv文本路径
Open fTextDir For Input As #1 ' 导入文本
Do While Not EOF(1) '逐行循环
Line Input #1, currLine '取第一行，并赋值
If Right(currLine, pintLen) = Title Then
Range(Cells(rowIndex, 1), Cells(rowIndex, 4)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.RowHeight = 27.75
.Font.Name = "Arial"
.Font.Size = 18
.Font.Bold = True
.FormulaR1C1 = Title
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
End With
Else
rowDataArr = Split(currLine, ",")
For i = 0 To UBound(rowDataArr)
Cells(rowIndex, i + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.RowHeight = 20
.Font.Name = "Arial"
.Font.Size = 12
.Font.Bold = False
.FormulaR1C1 = rowDataArr(i)
End With
Next i
End If
rowIndex = rowIndex + 1
Loop
Close #1
End Sub

追问

谢谢,不许要太多无关的代码,只要将.csv 中的C1:H15复制到.xlsm中的D2:I16

追答

手里没有csv文件可测试,应该是没问题
csv文件一般有首行字段名称，所以要确定是否有首行
如果表中第一行数据出现标题行，请变量tYesNO设为1就可以了，其它不用变更

Sub fMain()
    Dim fTextDir As String, rowIndex As Integer, i As Integer
    rowIndex = 1：tYesNO=0    'tYesNO为0表示没有首行，如果有改成1
    fTextDir = "D:/status.csv" ' csv文本路径
    Open fTextDir For Input As #1 ' 导入文本
    Do While Not EOF(1) '逐行循环
        Line Input #1, currLine '取第一行，并赋值
        if tYesNO=0 or rowindex>1 then
        rowDataArr = Split(currLine, ",")
        For i = 3 To 8
            Cells(rowIndex + 1-tYesNO, i + 4).FormulaR1C1 = rowDataArr(i)
        Next i
        end if
        rowIndex = rowIndex + 1
        If rowIndex-tYesNo > 15 Then Exit Do
    Loop
    Close #1
End Sub

Answer 2

Sub AAA()
    Dim Ar, Br, Cr
    Dim I&, J&, R1&, R2&, C1&, C2, X&, Y&
    Dim Rng As Range
    Dim S   As String
    Set Rng = [D2:I16]       '数据粘贴区域
    Ar = Rng
    R1 = 1              '复制区域起始行  --
    R2 = 15             '复制区域结束行   丨---[C1:H15]
    C1 = 3              '复制区域起始列   丨
    C2 = 8              '复制区域结束列  --
    '注意修改文件路径
    'Open ThisWorkbook.Path & "\Book1.csv" For Binary As #1 '如果是当前工作簿所在目录可以这样
    Open "F:\下载\Book1.csv" For Binary As #1
        S = StrConv(InputB(LOF(1), 1), vbUnicode)
    Close #1
    Br = Split(S, vbCrLf)
    For I = R1 To R2
        X = X + 1
        Y = 0
        Cr = Split(Br(I - 1), ",")
        For J = C1 To C2
            Y = Y + 1
            Ar(X, Y) = Cr(J - 1)
        Next
    Next
    Rng = Ar
End Sub