Question

开始一个新线程来调整我编写的代码（在@Doomenik的帮助下，因为我是VB的新手，谢谢你先生！）

基本上，我的代码循环遍历代表客户的每个工作表，并将指定单元格/范围内的数据发送到＆＃34;摘要＆＃34;片材。

一切正常但我现在无法做到的是检索范围，使用每条记录之间的换行符将值连接到一个单元格中。

示例：

客户名称：B9

产品A：H10：H34

产品B：H38：H49

其他产品：Q10：Q20

在线访问：R37

如果产品A /产品B /其他产品具有多个值，如何将这些值连接到它复制到摘要表中的单元格而不是整个行？

示例：

现状：产品1（B1），产品2（C1），产品3（D1）等（跨行）

首选州：

（全部在B1中有换行符）

产品1

产品2

产品3

以下是我的代码。我真的很感激帮助。对于任何希望进行摘要页面并且易于修改的人来说，这是一个非常棒的代码，所以请随时复制和使用。

Sub Summary_All_Worksheets_With_Formulas()
    Dim Sh As Worksheet
    Dim Req As Worksheet
    Dim myCell As Range
    Dim sumCell As Object
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim basebook As Workbook
        With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'Add a worksheet with the name "Requirements Gathering"
    Set basebook = ThisWorkbook
    Set Req = Worksheets("Requirements Gathering")
    'The links to the first sheet will start column 2
    ColNum = 0

    For Each Sh In basebook.Worksheets
        If Sh.Name <> Req.Name And Sh.Visible Then
            RwNum = 13
            ColNum = ColNum + 2

            'Copy the sheet name in the A column

            Req.Cells(RwNum, ColNum).Value = " "
                For Each myCell In Sh.Range("B9,H10:H34,H38:H49,Q10:Q20,R37")
                  If myCell.Value <> "" Then
                    RwNum = RwNum + 1
                    Req.Cells(RwNum, ColNum).Formula = _
                    "='" & Sh.Name & "'!" & myCell.Address(False, False)
                    Req.Cells.NumberFormat = "General"

                    myCell.Copy

                    Req.Cells(RwNum, ColNum).PasteSpecial Paste:=xlPasteFormats
                  End If
                Next myCell
        End If

    Next Sh

    Req.UsedRange.Columns.AutoFit
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With


End Sub

使用换行符（vbCrlf）连接检索到的范围？

0 个答案: