如何复制范围和粘贴在1列

时间:2016-07-21 05:56:10

标签: excel vba excel-vba excel-2010 excel-2007

任何人都有一些想法用Excel中的VBA制作这样的东西。请...

Range (D2 : M4) 

1   2  3  4  5  6  7  8  9  10

11 12 13 14 15 16 17 18 19 20

21 22 23 24 25 26 27 28 29 30  

Sample Data

仅粘贴在1列B或范围(B3:B33)上,如下所示:

1

2

3

4

5

6

7

....etc

30

Results

3 个答案:

答案 0 :(得分:0)

尝试使用以下代码。它会起作用

Sub test()
    Dim i As Long
    For i = 2 To 4
        If i = 2 Then
            Sheets("Sheet3").Range("D" & i, "M" & i).Copy
            Sheets("Sheet3").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Else
            Sheets("Sheet3").Range("D" & i, "M" & i).Copy
            Sheets("Sheet3").Range("B" & Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If
    Next i
End Sub

答案 1 :(得分:0)

如果您只需要粘贴值

package osvin.com.edittext;

import android.os.Bundle;
import android.support.v7.app.AppCompatActivity;
import android.text.Editable;
import android.text.TextWatcher;
import android.util.Log;
import android.widget.EditText;

public class MainActivity extends AppCompatActivity implements  TextWatcher{

     EditText edt_1,edt_2,edt_3,edt_4;
     StringBuilder sb;
     @Override
     protected void onCreate(Bundle savedInstanceState) {
        super.onCreate(savedInstanceState);
        setContentView(R.layout.activity_main);

        Intialize();
        edt_1.addTextChangedListener(this);
        edt_2.addTextChangedListener(this);
        edt_3.addTextChangedListener(this);
        edt_4.addTextChangedListener(this);
     }
     public void Intialize(){
        edt_1=(EditText)findViewById(R.id.edt_1);
        edt_2=(EditText)findViewById(R.id.edt_2);
        edt_3=(EditText)findViewById(R.id.edt_3);
        edt_4=(EditText)findViewById(R.id.edt_4);
        sb=new StringBuilder();
     }

     @Override
     public void beforeTextChanged(CharSequence s, int start, int count, int after) {

        if(sb.length()==1)
        {
           sb.deleteCharAt(0);

        }
     }

     @Override
     public void onTextChanged(CharSequence s, int start, int before, int count) {

        if (sb.length() == 0&&edt_1.length() == 1) {

            sb.append(s);
            Log.e("StringBuilderLength", "--------" + sb.length());
                edt_1.clearFocus();
                edt_2.requestFocus();
                edt_2.setCursorVisible(true);

        }
        if (sb.length() == 0&&edt_2.length() == 1) {
            sb.append(s);
            Log.e("StringBuilderLength", "--------2" + sb.length());
                edt_2.clearFocus();
                edt_3.requestFocus();
                edt_3.setCursorVisible(true);

        }
        if (sb.length() ==0&&edt_3.length() == 1) {
            sb.append(s);
            Log.e("StringBuilderLength", "--------3" + sb.length());
                edt_3.clearFocus();
                edt_4.requestFocus();
                edt_4.setCursorVisible(true);
            }
            if (sb.length() ==0&&edt_4.length() == 1) {
                sb.append(s);
                Log.e("StringBuilderLength", "--------4" + sb.length());
                edt_4.requestFocus();
                edt_4.setCursorVisible(true);
            }

     }

     @Override
     public void afterTextChanged(Editable s) {


     }


}

如果您需要粘贴“全部”单元格

Sub main()
    Dim i As Long
    Dim cell As Range

    For Each cell In Range("D2:M4")
        Range("B3").Offset(i).Value = cell.Value
        i = i + 1
    Next cell
End Sub

答案 2 :(得分:0)

我看到你有一个接受的答案,但这是一个使用公式 TRANSPOSE 的替代解决方案:

Sub TransposeData()
Dim Data As Range, iRow&, RowData&, ColData&

Set Data = Worksheets("Sheet1").Range("D2:M4")
RowData = Data.Rows.Count: ColData = Data.Columns.Count

For iRow = 1 To RowData
    Range("B" & 3 + (iRow - 1) * ColData).Resize(ColData, 1) = WorksheetFunction.Transpose(Data.Rows(iRow))
Next

End Sub

请注意,它只会复制粘贴该值,其格式不包括在内。