简体   繁体   中英

VBA script or excel formula to add data in a worksheet from another workbook, based on a set of rules

I need to make a macro that copies data from a CentralData workbook into another workbook, based on a set of conditions.

Below you'll find the general format of both files:

合成文件 中央数据

1st picture is the simulation of the synth file where i want data from the other to be pasted. Date column represents generic dates with the format 'mm/dd/yy'. Central data is the second file from where i want the data to be extracted. The numbers in the cells are just a simulation with generic numbers, in order to see how it needs to be filled.

The bankdata is a separate file that doesn't have a part in the problem, but helps visualize the format of the synth file. Delta is the difference between CentralData and synth. That cell and bankdata needs to be skipped.

The second file, CentralData, contains the filename from which the data is extracted. The file names, although it seems random, are a combinatins of standard string (sometimes separated by a symbol), the file date (date format 'ddmmyy') and '.fileextension'.

The objective is, according to the common date from both table, in the CentralData line from synth, to paste each value from CentralData, that match the method. (think payment method) for every line in the synth and every line in CentralData file, until everything in populated in the synth.

First, i tried with functions like =IF(AND($B2="CentralData";'[centralData.xlsx]Sheet1';$B2="method2").'[centralData;xlsx]Sheet1',$C2." ") for each method, or to create some kind of token system to match the date from synth with the date from CentralData, In the end. it failed, or works for some data.

Now, i'm trying to make a macro that copies sums from central data to synth, based on date, method, and column, and, by now i have this:

Sub FillData()
'will get data from CentralData and paste it into synth, according to a set of conditions
'
'
'
Dim x As Integer                    'will store sums
Dim wb, wbsec As Workbook           'wb-primary workbook (synth) wbsec-secondary workbook hat will do all the operations
Dim ws As Worksheet
Dim mainstr, workingstr As String   'mainstr will store the date conversion and workingstr will store conditions and other string type variables

'Workbooks.Open ("") 
'Set ws = Sheet1                     

'split the text in the first column and store only the numeric value
Dim newr As Variant
Range("b:b").Insert
Dim newr As Range
newr = Range("A2")
Dim i As Integer


'convert left number into date format
Range("B:B").NumberFormat = "mmddyy"


End Sub

Public Function SplitText(pWorkRng As Range, pIsNumber As Boolean) As String

Dim xLen As Long
Dim xStr As String
xLen = VBA.Len(pWorkRng.Value)
For i = 1 To xLen
    xStr = VBA.Mid(pWorkRng.Value, i, 1)
    If ((VBA.IsNumeric(xStr) And pIsNumber) Or (Not (VBA.IsNumeric(xStr)) And Not (pIsNumber))) Then
        SplitText = SplitText + xStr
    End If
Next

End Function

Now, i need to convert the short date from filename to an actual date (kinda done) and to compare with the date from synth, then, i'll write the other conditions. Is this the best approach? How should i proceed from here? Are there more things i need to provide?

Thanks in advance!

In order to transform the file name numeric part in Date , please try using the next function. It assumes that the month inside the numeric string is always composed from two digits, except the case when both (day and month) are composed from only one digit. If the numeric part is not consistent and it may contain also months of one digit and day of two digits, nobody can extract a real Date from such a bad construction:

Function extractDt(fileName As String) As Date
   Dim strNum As String, Dt As Date
    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d{4,6})" 'number digits, from 4 to 6
        .Global = True
        If .test(fileName) Then
            strNum = CStr(.Execute(fileName)(0))
        End If
    End With
    If Len(strNum) = 6 Then
        Dt = DateSerial(20 & CLng(Right(strNum, 2)), CLng(Mid(strNum, 3, 2)), CLng(left(strNum, 2)))
   ElseIf Len(strNum) = 5 Then
        Dt = DateSerial(20 & CLng(Right(strNum, 2)), CLng(Mid(strNum, 2, 2)), CLng(left(strNum, 1)))
   ElseIf Len(strNum) = 4 Then
        Dt = DateSerial(20 & CLng(Right(strNum, 2)), CLng(Mid(strNum, 2, 1)), CLng(left(strNum, 1)))
   End If
   extractDt = Dt
End Function

It can be tested using the next way:

Sub testExgtractNumb()
   Dim strNum As String
   Debug.Print extractDt("filename011121")
   'Debug.Print extractDt("filename11121")
   'Debug.Print extractDt("filename1721")
End Sub

Please, uncomment the lines with different numeric representation of Date and see the result in Immediate Window .

If you will answer my clarification questions, I will try a global response. Now I cannot understand what you mean. Your question is not to clear from the mentioned aspects, point of view...

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM