Getting data out of an array and writing it to a defined cell

时间:2019-01-09 21:48:23

标签: excel vba excel-formula

I have a loop running, and I am trying to combine the results in the array, match those results to a Defined Cell Name, and write another result within the same array to the same cell as the defined name. It is pull data from a tab delimited text file.

The array comes out like this

"01/08/2019 18:00:00 BRANDED LOC PN THE PRODUCT NAME +3.46 ThePrice"

I need to concant LOC and PN in to the follow format "LOC_PN", find the Defined Cell with the "LOC_PN" name, and then write ThePrice to that cell on the ActiveSheet.

Public Sub ImportPrices_Click()
    ''Declare Variables
    Dim PathName As String
    Dim FileName As String        

    Set fs = CreateObject("Scripting.FileSystemObject")

    PathName = "??????"        

    ''AP Prices
    FileName = PathName & "\" & "APPrices.txt"
    Set AP = fs.OpenTextFile(FileName, 1)

    Dim arrAP()
    i = 0

    Do While Not AP.AtEndOfStream
        ReDim Preserve arrAP(i)
        arrBP(i) = AP.ReadLine
    Loop      

    ap.Close
End Sub

I appreciate your help ahead of time. I have been banging my head against my desk trying to figure out the writing part.

1 个答案:

答案 0 :(得分:1)

文本文件的问题和数据布局不清楚。从“将这些结果与定义的单元格名称匹配”的要求中我所理解的,我认为根本不需要将每一行存储到一个数组中。但是在您的代码中

  1. 我没有增加
  2. 找到了arrBP而不是arrAP的分型

更正上面的内容可能会为您提供APPrices.txt每行的数组,以供进一步处理。

但是,如果文本文件的数据布局和您的要求如下 enter image description here

然后可以尝试不使用数组的简单代码

 Option Base 0
 Public Sub ImportPrices_Click()
''Declare Variables
Dim PathName As String
Dim FileName As String

Set fs = CreateObject("Scripting.FileSystemObject")
PathName = "C:\Users\user\Desktop"
FileName = PathName & "\" & "APPrices.txt"
Set ap = fs.OpenTextFile(FileName, 1)

Dim Cols As Variant, Ln As String, Price As String, LocPin As String
    Do While Not ap.AtEndOfStream
    Ln = ap.ReadLine
    Cols = Split(Ln, Chr(9))   ' each line is splited on tab ie Chr(9)
    Price = Cols(7)
    LocPin = Cols(3) & Cols(4)
    Debug.Print LocPin, Price
    'you may match the locPin here and put the price the cells
    Loop
ap.Close

End Sub

或者其他简单的方法(根据需求进行修改)

Sub test2()
Dim wb As Workbook
Dim Rng As Range, C As Range, LastRow As Long
Workbooks.OpenText FileName:="C:\Users\user\Desktop\APPrices.txt", Origin:=437, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1)), _
        TrailingMinusNumbers:=True
Set wb = ActiveWorkbook

    For Each Rng In wb.ActiveSheet.UsedRange.Columns(8).Cells
    Rng.Offset(, 1).FormulaR1C1 = "=RC[-5]&RC[-4]"      'Create column  9 With concanted LOc & Pin
    Next

    'Search Column 9 LOcPIN
    For Each Rng In ThisWorkbook.Worksheets("Sheet1").Range("A2:A25").Cells
    Set C = wb.ActiveSheet.Columns(9).Find(Rng.Value) ', LookIn:=xlValues) ', Lookat:=xlWhole)
        If Not C Is Nothing Then
        Rng.Offset(, 1).Value = C.Offset(, -1).Value                        ' Price
        End If
    Next Rng
wb.Close False
End Sub