不连续的命名范围到一个数组，然后进入不同的排片 [英] Non-contiguous named range into an array, then into row in different sheet

问题描述

我试图从一个不连续的范围将公布一排在一个单独的表数据。之前，我建立了非连续的范围内，这code完美。我已经通过试几件事情要循环，但没有我尝试将工作。因为它位于它不会复制数据不等。它已经多年，因为我实际上做任何编码和我重新学习曲线，似乎抱着我回....逻辑只是不来找我。救命啊！

 子UpdateLogWorksheet（）昏暗historyWks作为工作表
昏暗inputWks作为工作表昏暗nextRow只要
昏暗oCol只要昏暗myCopy由于范围
昏暗MYTEST由于范围
昏暗的myData由于范围昏暗LRSP只要（输入）设置inputWks =工作表
设置historyWks =工作表（DataEntry）
oCol = 3'订单信息粘贴在数据表中，此列首发为您在数据库中的重复VIN
如果inputWks.Range（CheckVIN）= true，那么
  LRSP = MSGBOX（VIN已在数据库中。更新记录吗？，vbQuestion + vbYesNo，重复VIN）
  如果LRSP = vbYes然后
    UpdateLogRecord
  其他
    MsgBox请更改VIN至一个唯一的编号。
  万一其他  细胞从输入表复制 - 一些包含公式  设置myCopy = inputWks.Range（VehicleEntry）'非连续命名范围  随着historyWks
      nextRow = .Cells（.Rows.Count，A）。完（xlUp）.Offset（1,0）.Row
  结束与  随着inputWks
      必填字段在隐藏列测试
      设置MYTEST = myCopy.Offset（0，2）      如果Application.Count（MYTEST）GT; 0，则
          MsgBox请填写所有的细胞！
          退出小组
      万一
  结束与  随着historyWks
      输入日期和时间标记记录
      随着.Cells（nextRow，A）
          .value的=现在
          .NumberFormat =MM / DD / YYYY HH：MM：SS
      结束与
      列B'输入用户名
      .Cells（nextRow，B）。值= Application.UserName
      复制的车辆数据，并粘贴到数据表      myCopy.Copy
      .Cells（nextRow，oCol）.PasteSpecial粘贴：= xlPasteValues​​，移调：= TRUE
      Application.CutCopyMode =假
  结束与  清输入单元格包含常数
  明确
万一结束小组
 

解决方案

这是一个示例，以解释如何实现你想要的。请修改code，以满足您的需求。

让我们说，我有一个工作表Sheet1 它看起来像如下图所示。颜色的单元格从我的非连续范围的弥补。

现在粘贴一个模块在下面给出的code和运行它。输出将在 Sheet2中和表Sheet 3

生成

code

 子样品（）
    昏暗的RNG作为范围，aCell作为范围
    昏暗MyAr（）为Variant
    昏暗N当，我只要    ~~＆GT;更改此相关表
    随着工作表Sheet1
        ~~＆GT;不相邻的范围
        设置RNG = .Range（A1：C1，B3：D3，C5：G5）        ~~＆GT;得到的细胞的计数在该范围内
        N = rng.Cells.Count        ~~＆GT;调整数组来保存数据
        使用ReDim MyAr（1到n）        N = 1        ~~＆GT;从范围到存储值
        ~~＆GT;数组
        对于每个aCell在rng.Cells
            MyAr（N）= aCell.Value
            N = N + 1
        接下来aCell
    结束与    ~~＆GT;产出表中的数据    ~~＆GT;纵向输出到表2
    Sheet2.Cells（1，1）.Resize（UBound函数（MyAr），1）。价值= _
    Application.WorksheetFunction.Transpose（MyAr）    ~~＆GT;横向输出到纸张3
    Sheet3.Cells（1，1）.Resize（1，UBound函数（MyAr））。值= _
    MyAr
结束小组
 

垂直输出

水平输出

希望上面的例子可以帮助你实现你想要的东西。

I'm trying to get data posted from a non-contiguous range into a row in a separate sheet. Before I built the non-contiguous range, this code worked perfectly. I've tried several things to loop through, but nothing I tried will work. It won't copy the ranged data as it sits. It's been years since I've actually done any coding and my re-learning curve seems to be holding me back.... the logic just isn't coming to me. Help!

Sub UpdateLogWorksheet()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myCopy As Range
Dim myTest As Range
Dim myData As Range

Dim lRsp As Long

Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("DataEntry")
oCol = 3 'order info is pasted on data sheet, starting in this column

'check for duplicate VIN in database
If inputWks.Range("CheckVIN") = True Then
  lRsp = MsgBox("VIN already in database. Update record?", vbQuestion + vbYesNo, "Duplicate VIN")
  If lRsp = vbYes Then
    UpdateLogRecord
  Else
    MsgBox "Please change VIN to a unique number."
  End If

Else

  'cells to copy from Input sheet - some contain formulas

  Set myCopy = inputWks.Range("VehicleEntry") 'non-contiguous named range

  With historyWks
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With inputWks
      'mandatory fields are tested in hidden column
      Set myTest = myCopy.Offset(0, 2)

      If Application.Count(myTest) > 0 Then
          MsgBox "Please fill in all the cells!"
          Exit Sub
      End If
  End With

  With historyWks
      'enter date and time stamp in record
      With .Cells(nextRow, "A")
          .Value = Now
          .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      'enter user name in column B
      .Cells(nextRow, "B").Value = Application.UserName
      'copy the vehicle data and paste onto data sheet

      myCopy.Copy
      .Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      Application.CutCopyMode = False
  End With

  'clear input cells that contain constants
  Clear
End If

End Sub

解决方案

This is an example to explain how to achieve what you want. Please amend the code to suit your needs.

Let's say, I have a Sheet1 which looks like as shown below. The colored cells make up from my non contiguous range.

Now paste the code given below in a module and run it. The output will be generated in Sheet2 and Sheet3

Code

Sub Sample()
    Dim rng As Range, aCell As Range
    Dim MyAr() As Variant
    Dim n As Long, i As Long

    '~~> Change this to the relevant sheet
    With Sheet1
        '~~> Non Contiguous range
        Set rng = .Range("A1:C1,B3:D3,C5:G5")

        '~~> Get the count of cells in that range
        n = rng.Cells.Count

        '~~> Resize the array to hold the data
        ReDim MyAr(1 To n)

        n = 1

        '~~> Store the values from that range into
        '~~> the array
        For Each aCell In rng.Cells
            MyAr(n) = aCell.Value
            n = n + 1
        Next aCell
    End With

    '~~> Output the data in Sheet

    '~~> Vertically Output to sheet 2
    Sheet2.Cells(1, 1).Resize(UBound(MyAr), 1).Value = _
    Application.WorksheetFunction.Transpose(MyAr)

    '~~> Horizontally Output to sheet 3
    Sheet3.Cells(1, 1).Resize(1, UBound(MyAr)).Value = _
    MyAr
End Sub

Vertical Output

Horizontal Output

Hope the above example helps you in achieving what you want.

这篇关于不连续的命名范围到一个数组，然后进入不同的排片的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！