Question

首先：非常感谢这个网站以及你们所做的所有贡献！我在这里找到了很多关于VBA使用的帮助，我在MS Excel中练习这次我有点卡住...... :-)现在它可以工作（10.01.2017），见下面的代码。

我试着在这里保持简短。如果需要更多细节，请告诉我。情况：

多个.csv个文件作为分析机器的输出;
标题=第一行，从第二行开始的分析值;
第一行变量中的标题数（取决于测量方法）;
标题的名称始终相同（元素和西格玛错误）;
只需要选定的列（元素）;
按原子重量排序（字母表在这里没有意义）;
通过单击按钮合并到单个Excel工作表（=新输出工作表）中，并使用MsgBoxes引导的VBA工作表进行＆＃34;仅适用于＆＃34;用户。

更多信息：我不是程序员或开发人员，而是自学成才的VBA新手到目前为止我有什么？能够：

的VBA文件

导入所选文件（用户选择，按提示窗口）.csv文件并将它们相互重叠 - ＆GT;感谢这些家伙＆＃34;操作方法＆＃34;：http://www.rjsherman.com/vba/2014/import-txt-or-csv-file-into-excel-via-a-macro-querytable/。

麻烦的是我之后用来复制数据的代码 - 为了为我创建一个可用的数据表 - 是非灵活的，并且需要来自.csv文件的整个数据按字母顺序排序。在化学元素的情况下，这是困扰我感谢社区，我可以找到下面的代码，只需要找到一种方法让它循环遍历我的所有数据我通过将nCopyRow = ActiveCell.Row调整为一个循环来实现这一点，其中nCopyRow = i并且i从第2行循环到LastRow。

我在此论坛中找到的比较/粘贴代码如下：https://stackoverflow.com/users/3561813/user3561813。谢谢你！
现在这里是最低限度的改编版本：

Sub b_compareandpaste()
'
'Thanks to user3561813 from Stackoverflow for providing a solution to this problem as defined here:
'https://stackoverflow.com/questions/28055026/storing-headers-in-string-array-vba
'Define variables
Dim wsOrigin As Worksheet
Dim wsDest As Worksheet
Dim nCopyRow As Long
Dim nPasteRow As Long
Dim rngFnd As Range
Dim rngDestSearch As Range
Dim cel As Range
Dim LastRow As Long, i As Long

'Define LastRow in Sheet(2) of the ActiveWorkbook
LastRow = ActiveWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row

Const ORIGIN_ROW_HEADERS = 1
Const DEST_ROW_HEADERS = 1

Set wsOrigin = Sheets("Kontrolltabelle")
Set wsDest = Sheets("RoHS-Tabelle")

'Here only the active cell got copied and sorted into the new columns
''nCopyRow = ActiveCell.Row
'This had to be modified in order to loop through all results from the *.CSV Import!
For i = 2 To LastRow
    nCopyRow = i
    'setting up a nested loop to go through all rows provided by the .CSV file
    nPasteRow = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1
    '
    Set rngDestSearch = Intersect(wsDest.UsedRange, wsDest.Rows(DEST_ROW_HEADERS))
        For Each cel In Intersect(wsOrigin.UsedRange, wsOrigin.Rows(ORIGIN_ROW_HEADERS))
            On Error Resume Next
             'the LookAt parameter had to be defined here as xlWhole and not left to standard xlPart. Otherwise Index became Indium (In) and
             'Units became Nickel (Ni) :-)
                Set rngFnd = rngDestSearch.Find(cel.Value, LookAt:=xlWhole, MatchCase:=True)
                '
                If rngFnd Is Nothing Then
                'Do Nothing as Header Does not Exist
                Else
                wsDest.Cells(nPasteRow, rngFnd.Column).Value = wsOrigin.Cells(nCopyRow, cel.Column).Value
             End If
            'Here is why my sheet1 got filled with 0's, when the loop on the nCopyRow failed: :-)
            On Error GoTo 0

        Set rngFnd = Nothing
    Next cel
Next i
'    
End Sub

现在通过将nCopyRow = ActiveCell.Row调整为循环，将检查包含数据的.CSV文件提供的所有行并将其复制到另一张表中。
只有当原始和目标表单的标题重叠时才会进行复制，这意味着目标表中用户编写的标题只允许复制相关数据。

感谢社区，coulnd没有你这样做，我希望这一点可以帮助别人。

问候，A。

EDIT5：
做好了！相应调整整个职位。
谢谢大家。

VBA，.CSV，使用/比较标题

0 个答案: