返回与两个搜索条件相邻的值

时间:2016-08-14 09:51:16

标签: vba excel-vba excel

我需要从像这样的表中找到与两个搜索条件相邻的值:

enter image description here

我写的代码是:

Dim mAin As Worksheet
Dim findc As Range
Dim findsc As Range
Dim code As Long
Dim scode As Integer
Dim i As Integer
Dim ttlrw As Long

i = 1
Set mAin = ActiveSheet
ttlrw = mAin.Columns(1).SpecialCells(xlCellTypeConstants).Count

Do
    code = mAin.Cells(i, 5).Value
    scode = mAin.Cells(i, 6).Value

    Set findc = mAin.Columns(1).Find(code)
    Set findsc = mAin.Columns(2).Find(scode)
    Do
        Set findc = mAin.Columns(1).FindNext(findc)
        Set findsc = mAin.Columns(2).FindNext(findsc)
    Loop Until findc.Row = findsc.Row

    mAin.Cells(i, 7).Value = findsc.Offset(0, 1).Value
    i = i + 1
Loop Until i = ttlrw + 1

找到的值应该与相似的表相邻输出,除了更混乱。

此外,宏在第5行之后进入无限循环。

我设法使用INDEX,MATCH和& s并将其转换为数组公式来解决这个问题;但我也希望进一步提高我对VBA的了解。

2 个答案:

答案 0 :(得分:0)

有很多方法可以做你想要的。

public class DeletableImageView extends LinearLayout {

    private ImageView mImage;
    private Button mButton;

    DeletableImageListener mListener

    public DeletableImageView(Context context) {
        super(context);
        init(context);
    }

    public DeletableImageView(Context context, AttributeSet attrs) {
        super(context, attrs);
        init(context);
    }

    public DeletableImageView(Context context, AttributeSet attrs, int defStyleAttr) {
        super(context, attrs, defStyleAttr);
        init(context);
    }

    private void init(Context context) {
        setOrientation(LinearLayout.VERTICAL);
        inflate(context, R.layout.deletable_image, this);
        initViews();
    }

    private void initViews() {
        mImage= (ImageView) findViewById(R.id.image);
        mButton= (Button) findViewById(R.id.delete_button);
        mButton.setOnClickListener(new OnClickListener() {
            @Override
            public void onClick(View view) {
                if (mListener != null) {
                    mListener.deleteMe(DeletableImageView.this);
                }
            }
        }
    }

    public void setListener(DeleteableImageListener listener) {
        mListener = listener;
    }

    public interface DeletableImageListener {
        void deleteMe(DeletableImageView me);
    }

   public void setImage(Drawable drawable) {
       mImage.setBackground(drawable);
   }
}

答案 1 :(得分:0)

试试这个

Option Explicit

Sub mAin()
    Dim mAin As Worksheet
    Dim cell As Range

    With Worksheets("mAin") '<--| '<-- change "mAin" with your actual sheet name
        .Rows(1).Insert '<--| insert a dummy header row, it'll be eventually removed
        .Cells(1, 1).Resize(, 2).Value = Array("head1", "head2") '<--| write dummy headers
        With .Range("A1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| reference its range in columns A:B from row 1 to column "A" last non empty cell row
            For Each cell In .Parent.Columns(5).SpecialCells(xlCellTypeConstants) '<-- loop through column "E" non empty cells
                .AutoFilter field:=1, Criteria1:=cell.Value 'operator:=xlAnd, '<--| filter referenced range on its 1st column with current cell value
                .AutoFilter field:=2, Criteria1:=cell.Offset(, 1).Value 'operator:=xlAnd, '<--| filter referenced range again on its 2nd column with current cell adjacent column value
                If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered...
                    cell.Offset(, 2) = .Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 3) '<--| copy current cell offseted 2 columns value to column "G"
                End If
                .Parent.AutoFilterMode = False '<--| show all rows back
            Next cell
        End With
        .Rows(1).Delete '<--| remove dummy header row
    End With
End Sub