复制单元格和相邻单元格并插入新行：Excel VBA

Question

我试图将一个单元格和相邻的单元格连续复制并插入一个新行，同时复制该单元格右侧的所有数据。挖掘后我的数据看起来像这样。

我试图让我的数据看起来像这样： 上面的图像只是一个记录，但基本上它将所有人及其在原始行中的相应位置移动到一个新行。每排约有5名员工及其职位。

感谢

EDIT尝试仅使用2个cols的代码。 1个位置。我的想法是创建空行，然后使用自动填充复制其余数据，然后从那里开始工作

  private Uri mCropImageUri;

 @Override
protected void onCreate(Bundle savedInstanceState) {
    super.onCreate(savedInstanceState);
    setContentView(R.layout.activity_main);

    txtExtracted = (TextView) findViewById(R.id.txtRetrieved);

    btnStartCrop = (Button) findViewById(R.id.btnStartCrop);

    imageView = (ImageView) findViewById(R.id.imgView);

    View v1 = getWindow().getDecorView().getRootView();
    v1.setDrawingCacheEnabled(true);
    Bitmap bitmap = Bitmap.createBitmap(v1.getDrawingCache());
    imageView.setImageBitmap(bitmap);

   btnStartCrop.setOnClickListener(new View.OnClickListener() {
        @Override
        public void onClick(View v) {

        }
    });
  }

@Override
@SuppressLint("NewApi")
protected void onActivityResult(int requestCode, int resultCode, Intent data) {

    if (requestCode == CropImage.CROP_IMAGE_ACTIVITY_REQUEST_CODE) {
        CropImage.ActivityResult result = CropImage.getActivityResult(data);
        if (resultCode == RESULT_OK) {
            ((ImageView) findViewById(R.id.quick_start_cropped_image)).setImageURI(result.getUri());
            Toast.makeText(this, "Cropping successful, Sample: " + result.getSampleSize(), Toast.LENGTH_LONG).show();
        } else if (resultCode == CropImage.CROP_IMAGE_ACTIVITY_RESULT_ERROR_CODE) {
            Toast.makeText(this, "Cropping failed: " + result.getError(), Toast.LENGTH_LONG).show();
        }
    }
}

private void startCropImageActivity(Uri imageUri) {
    CropImage.activity(imageUri)
            .setGuidelines(CropImageView.Guidelines.ON)
            .setMultiTouchEnabled(true)
            .start(this);
}

Answer 1

如果每行总共有5个人，那么应该这样做：

Sub foo()
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow 'loop through rows
    For x = 1 To 10 Step 2 'loop through columns
        LastRow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 'find the next free row on Sheet2
        Sheet2.Cells(LastRow2, 1).Value = Sheet1.Cells(i, x).Value 'add Person Name to Sheet2
        Sheet2.Cells(LastRow2, 2).Value = Sheet1.Cells(i, x + 1).Value 'add position to Sheet2
        Sheet1.Range("K" & i & ":U" & i).Copy Destination:=Sheet2.Cells(LastRow2, 3) 'copy range from K to U to Sheet2
    Next x
Next i
End Sub