Question

我有2个工作表。第一个工作表有列：ID - UNIT - ENGLISH - DUTCH- WOORDSOORT - VOORBEELDZIN - FOTO

第二个工作表包含以下列：UNIT - ENGLISH - DUTCH- WOORDSOORT - VOORBEELDZIN - FOTO - THEMA - SUBTHEMA

我想将第二个工作表中的行中的“THEMA”和“SUBTHEMA”的值添加到第一个工作表中的相同行。如果第一个工作表中的行中的“UNIT - ENGLISH - DUTCH - WOORDSOORT - VOORBEELDZIN - FOTO”与第二个工作表中的行相同，请将该行中的值“THEMA”和“SUBTHEMA”添加到第一个工作表中的该行工作表。

2个工作表略有不同，因此我不能只复制粘贴其他列。

Answer 1

试试这个。它是一个快速的草稿，它可以使用数组更优雅地完成。但是，你明白了。

Sub AddValue()

Dim bytHeadersRowDestination As Byte, bytHeadersRow As Byte
Dim bytFirstColumnSource As Byte, bytFirstColumnDestination As Byte
Dim shtSource As Worksheet, shtDestination As Worksheet
Dim intLastRow As Integer 'change to long if you have more than 32 767 rows in database

'change Byte data type to something bigger (integer, long) if you have the tables in column 255 or further to the right
Dim bytSourceUnitColumn As Byte, bytSourceEnglishColumn As Byte
Dim bytSourceDutchColumn As Byte, bytSourceWoordsoortColumn As Byte
Dim bytSourceVoorbeeldzinColumn As Byte, bytSourceFotoColumn As Byte
Dim bytSourceThemaColumn As Byte, bytSourceSubThemaColumn As Byte

Dim bytDestinationUnitColumn As Byte, bytDestinationEnglishColumn As Byte
Dim bytDestinationDutchColumn As Byte, bytDestinationWoordsoortColumn As Byte
Dim bytDestinationVoorbeeldzinColumn As Byte, bytDestinationFotoColumn As Byte
Dim bytDestinationThemaColumn As Byte, bytDestinationSubThemaColumn As Byte

Dim intComparedRow As Integer

'change the values to your situation, presuming you have the tables on the same range, only in different sheets
bytHeadersRow = 1
bytFirstColumn = 1
Set shtSource = Worksheets(2)
Set shtDestination = Worksheets(1)

intLastRow = shtSource.Cells(bytHeadersRow, bytFirstColumn).End(xlDown).Row 'presuming you dont have blank cells in database

'find the column headers, you can replace this with simply setting the column numbers by hand. If they will always be on the same spot, that should work fine.
With shtSource.Cells()

    bytSourceUnitColumn = .Find(what:="UNIT").Column
    bytSourceEnglishColumn = .Find(what:="ENGLISH").Column
    bytSourceDutchColumn = .Find(what:="DUTCH").Column
    bytSourceWoordsoortColumn = .Find(what:="WOORDSOORT").Column
    bytSourceVoorbeeldzinColumn = .Find(what:="VOORBEELDZIN").Column
    bytSourceFotoColumn = .Find(what:="FOTO").Column
    bytSourceThemaColumn = .Find(what:="Thema").Column
    bytSourceSubThemaColumn = .Find(what:="SubThema").Column

End With

With shtDestination.Cells()

    bytDestinationUnitColumn = .Find(what:="UNIT").Column
    bytDestinationEnglishColumn = .Find(what:="ENGLISH").Column
    bytDestinationDutchColumn = .Find(what:="DUTCH").Column
    bytDestinationWoordsoortColumn = .Find(what:="WOORDSOORT").Column
    bytDestinationVoorbeeldzinColumn = .Find(what:="VOORBEELDZIN").Column
    bytDestinationFotoColumn = .Find(what:="FOTO").Column
    bytDestinationThemaColumn = .Find(what:="Thema").Column
    bytDestinationSubThemaColumn = .Find(what:="SubThema").Column

End With

'compare the 2 data rows, presuming they are on the same row, same number of data rows
For intComparedRow = bytHeadersRow + 1 To intLastRow

    If shtSource.Cells(intComparedRow, bytSourceUnitColumn) = shtDestination.Cells(intComparedRow, bytDestinationUnitColumn) And _
    shtSource.Cells(intComparedRow, bytSourceEnglishColumn) = shtDestination.Cells(intComparedRow, bytDestinationEnglishColumn) And _
    shtSource.Cells(intComparedRow, bytSourceDutchColumn) = shtDestination.Cells(intComparedRow, bytDestinationDutchColumn) And _
    shtSource.Cells(intComparedRow, bytSourceWoordsoortColumn) = shtDestination.Cells(intComparedRow, bytDestinationWoordsoortColumn) And _
    shtSource.Cells(intComparedRow, bytSourceVoorbeeldzinColumn) = shtDestination.Cells(intComparedRow, bytDestinationVoorbeeldzinColumn) And _
    shtSource.Cells(intComparedRow, bytSourceFotoColumn) = shtDestination.Cells(intComparedRow, bytDestinationFotoColumn) Then

    shtDestination.Cells(intComparedRow, bytDestinationThemaColumn) = shtSource.Cells(intComparedRow, bytSourceThemaColumn)
    shtDestination.Cells(intComparedRow, bytDestinationSubThemaColumn) = shtSource.Cells(intComparedRow, bytSourceSubThemaColumn)

    End If

Next intComparedRow

End Sub

将值添加到不同工作表中的相同行

1 个答案: