VBA - 根据另一列拉取同一行上的值 [英] VBA - Pulling a value on the same row based on another column

问题描述

我需要一个宏，它将向下滚动列B，直到它的值通过6.然后，在第一个值通过从列A中的该行的值（我将这个值称为X）然后转到同一本书中的另一张表格，并在列C之后插入3行已经变得大于或等于X.我对vba非常新鲜，不知道我在做什么，但是我在一个时间紧张，可以使用一些帮帮我。我不知道这是否会有帮助，但我写出了一些可能能够解释的超级伪代码。 （不仅需要X，而且我还需要一个Y在第二张表格的另一个位置插入3行）

  Survey.cell 
 dls = Where（column（J）> 6.0 get.row）
 kop =其中（列（B）符合dls）
 
调查.cell 
 inc = Where（column（C）> 85 get.row）
 lnd = Where（column（B）meet inc）
 
日志。 cell 
其中，cloumn（M）> = kip insert.row& inerst.row& insert.row 
其中列（M）> = lnd insert.row& insert.row& insert.row 
  

最近我可以找到的是这里：
如何在列中查找文本并保存首次找到的行号 - Excel VBA
但是，这不完全是我需要的。我感谢任何帮助。有一个美好的一天！

解决方案

如果我有你的问题，这应该做到这一点。如果工作表中还有非数字值，这将失败。

  Sub DoIt（）
 Dim i As Long 
 Dim x As Double 
 Dim Worksheet1 As Worksheet 
 Dim Worksheet2 As Worksheet 
 Dim ColumnA As Long 
 Dim ColumnB As Long 
 Dim ColumnC As Long 
 
设置Worksheet1 = ActiveWorkbook.Worksheets（Sheet1）'如果需要，更改工作表的名称
设置Worksheet2 = ActiveWorkbook.Worksheets（Sheet2）'如果需要更改工作表的名称
 ColumnA = 1'如果您想要其他列，则更改1 = A列，2 = B等
 ColumnB = 2 
 ColumnC = 3 
 
 
 i = 1 To Worksheet1.UsedRange.Rows.Count 
如果Worksheet1.Cells（i，ColumnB）.Value> 6然后
x = Worksheet1.Cells（i，ColumnA）.Value 
退出
结束如果
下一个
 
如果x = 0然后MsgBox否值大于6在表1中的colum b中找到
 
对于i = 1 To Worksheet2.UsedRange.Rows.Count 
如果Worksheet2.Cells（i，ColumnC）.Value> = x然后
 Worksheet2.Rows（i + 1）.Insert 
 Worksheet2.Rows（i + 1）.Insert 
 Worksheet2.Rows（i + 1）.Insert 
 Exit Sub 
结束如果
下一个
 
 MsgBox没有值大于& x& 在表2中的C列中找到
 End Sub 
  

I need a macro that will scroll down column B until it's values pass 6. Then, on the first value that passes take the value on that row from column A (I'll refer to this value as X) Then go to another sheet in the same book and insert 3 rows after column C has become greater than or equal to X. I am very new to vba and have no idea what I'm doing but, I'm in a time crunch and could use some help. I don't know if this will help but I wrote out some super pseudo code that might be able to explain it. (not only do I need an X but I also need a Y to insert 3 rows in another spot on the second sheet)

Survey.cell
    dls = Where(column("J") > 6.0 get.row)
    kop = Where(column("B") meets dls)

Survey.cell
    inc = Where(column("C") >85 get.row)
    lnd = Where(column("B") meets inc)

Journal.cell
    Where cloumn("M") >= kip insert.row & inerst.row & insert.row
    Where column("M") >= lnd insert.row & insert.row & insert.row

The closest thing I could find to this is here: How to find text in a column and saving the row number where it is first found - Excel VBA but, it's not exactly what I need. I appreciate any help offered. Have a good day!

解决方案

If I got your question right, this should do it. If there are also non-numeric values in the sheet, this will fail.

Sub DoIt()
    Dim i As Long
    Dim x As Double
    Dim Worksheet1 As Worksheet
    Dim Worksheet2 As Worksheet
    Dim ColumnA As Long
    Dim ColumnB As Long
    Dim ColumnC As Long

    Set Worksheet1 = ActiveWorkbook.Worksheets("Sheet1") ' Change name of sheet if necessary
    Set Worksheet2 = ActiveWorkbook.Worksheets("Sheet2") ' Change name of sheet if necessary
    ColumnA = 1  ' Change if you want other columns, 1 = A-column, 2 = B etc
    ColumnB = 2
    ColumnC = 3


    For i = 1 To Worksheet1.UsedRange.Rows.Count
        If Worksheet1.Cells(i, ColumnB).Value > 6 Then
            x = Worksheet1.Cells(i, ColumnA).Value
            Exit For
        End If
    Next

    If x = 0 Then MsgBox "No value greater then 6 found in colum b in sheet 1"

    For i = 1 To Worksheet2.UsedRange.Rows.Count
        If Worksheet2.Cells(i, ColumnC).Value >= x Then
            Worksheet2.Rows(i + 1).Insert
            Worksheet2.Rows(i + 1).Insert
            Worksheet2.Rows(i + 1).Insert
            Exit Sub
        End If
    Next

    MsgBox "No value greater then " & x & " found in column C in sheet 2"
End Sub

这篇关于VBA - 根据另一列拉取同一行上的值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！