向数据添加文本到不同单元格之间的移动

时间:2018-09-21 09:13:09

标签: excel vba excel-vba

所以我目前有此代码;

Function ISMERGED(CellAddress As Range) As Boolean
  ISMERGED = CellAddress.MergeCells
End Function

Sub Demerge()
Dim CurrentCell As Range
    For Each CurrentCell In ActiveSheet.UsedRange
        If ISMERGED(CurrentCell) Then CurrentCell.UnMerge
    Next
End Sub

Sub Txfer()
Dim x As Long
Dim TestRow As Range

Call Demerge

    With Worksheets("Sheet2")
        .UsedRange.Delete
        .Cells(1, 1).Formula = "Test Name"
        .Cells(1, 2).Formula = "Test Description"
        .Cells(1, 3).Formula = "Step Name"
        .Cells(1, 4).Formula = "Test Step"
        .Cells(1, 5).Formula = "Expected Result"
    End With

    With Worksheets("Sheet2")
        For x = 2 To Worksheets("Sheet1").UsedRange.Rows.Count
            If Worksheets("Sheet1").Cells(x, 2).Value <> "" Then
                .Cells(x, 2).Formula = Worksheets("Sheet1").Cells(x, 4).Value
                .Cells(x, 3).Formula = Worksheets("Sheet1").Cells(x, 2).Value
                .Cells(x, 4).Formula = Worksheets("Sheet1").Cells(x, 3).Value
                .Cells(x, 5).Formula = Worksheets("Sheet1").Cells(x, 5).Value
                'add in further columns
            Else
                .Cells(.UsedRange.Rows.Count, 4).Formula = .Cells(.UsedRange.Rows.Count, 4).Value & Chr(10) & Worksheets("Sheet1").Cells(x, 3).Value
                .Cells(.UsedRange.Rows.Count, 5).Formula = .Cells(.UsedRange.Rows.Count, 5).Value & Chr(10) & Worksheets("Sheet1").Cells(x, 5).Value
                'concatenate existing content of target cell with data from current source row
            End If

        Next x
    End With
    'now to tidy up the blanks...
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(Worksheets("Sheet2").UsedRange.Rows.Count, 2).Activate
    Do
        If Application.CountA(ActiveCell.EntireRow) = 0 Then ActiveCell.EntireRow.Delete
        ActiveCell.Offset(-1, 0).Activate
    Loop Until ActiveCell.Row < 2
    Range("A1:E1").Font.Bold = True
End Sub

我想添加一个“ if”语句,如果测试数据中有任何内容(这是“ Cells(x,2).Formula = Worksheets(“ Sheet1”)。Cells(x,4)中的数据源表的“ .Value”)字段中,我希望测试描述字段包含:“ Test Data:”,后跟源中的文本。如果源单元为空,我希望“描述”字段也为空。

基本上,我只想在要移动的文本之前添加单词“ Test Data”(如果它们是原始单元格中存在的文本)

0 个答案:

没有答案