Question

我的数据全部在一列中并向下增长。只有几行数据然后是空格（空格的数量不同）。

我正在尝试选择每组数据并将其自动转置到下一个可用行的下一个工作表中，并继续直到该列中没有更多数据。

请原谅我对下面的无知，我用了几个小时的谷歌搜索并搜索了这个网站。

这是我到目前为止所做的，它有点工作......但我认为我需要定义另一个整数，所以我可以得到一个要复制的范围，比如

Sheets("Sheet1").Range(A & I “:” A & X ).Copy

然后，粘贴的类似操作：

Sheets("Sheet2").End(xlUp).Row.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

我正在使用的完整宏：

Sub PadOut()
Application.ScreenUpdating = False

Dim i As Integer, j As Integer
j = 1
   'loops from 1 to the last filled cell in column 1 or "A"
    For i = 1 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row
       'checks if the cell has anything in it
        If IsEmpty(Sheets("Sheet1").Range("A" & i)) = False Then
            'this is where the copying and pasting happens (well basically)
            Sheets("Sheet1").Range(A & i).copy
            Sheets("Sheet2").End(xlUp).Row).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            j = j + 1
        End If
    Next i

    Application.ScreenUpdating = True

End Sub

Answer 1

代码就是这样。

Sub PadOut()
Application.ScreenUpdating = False

Dim i As Long
Dim n As Long
n = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

   'loops from 1 to the last filled cell in column 1 or "A"

    For i = 1 To n
       'checks if the cell has anything in it
        If IsEmpty(Sheets("Sheet1").Range("A" & i)) = False Then
            'this is where the copying and pasting happens (well basically)
            Sheets("Sheet1").Range("A" & i).Copy Sheets("Sheet2").Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next i

    Application.ScreenUpdating = True

End Sub

Answer 2

这里我定义了一个Source范围，然后使用Range的SpecialCells方法将源分解为区域。接下来，我遍历Source范围的区域并将它们转置到Sheet2上的下一个空单元格。

public function facebookSharing($access_token) {
        $app = new UEApp(env('UNIFICATION_APP_KEY'), env('UNIFICATION_APP_SECRATE'));
        $user = new UEUser('unification_userkey', 'unification_usersecret');
        $connection = $user->add_connection('FACEBOOK', "facebook", $access_token);
        $options = array(
            "receivers" => array(
                array(
                    "name"=> "Me"
                )
            ),
            "message"=>array(
                "subject"=>'testing',
                "body"=> 'description',
                "image"=> 'use any image url',
                "link"=>array(
                    "uri"=> 'any web site url',
                    "description"=> "",
                    "title"=>"Title"
                )
            )
        );
        $uris = $connection->send_message($options);
    }

Answer 3

跳过空白单元格的功能在您的情况下非常有用：

 var target;
 var select;
 var colors = ["brown", "cyan", "yellow", "red", "blue", "green", "black", "white", "purple", "pink"];
 var finished = false;

 function do_game() {
   var random_color = Math.floor(Math.random() * colors.length);
   target = colors[random_color];
 }
 while (!finished) {
   select = prompt("I am thinking of one of these colors\n\n brown,cyan,yellow,red,blue,green,black,white,purple,pink\n what color am i thinking of");
   finished = check_guess();
 }

 function check_guess() {
   if (select == target) {
     return true;
   } else {
     return false;
   }

 }

将cell作为参数，并查找下一个非空单元格。如果给定的单元格不为空，则返回其行，如果为空，则该函数将返回下一个非空单元格的行。使用该函数，我们可以编写以下内容：

Function SkipBlanks(start As Range) As Long
Dim r, c As Long
r = start.Row
c = start.Column
'we make sure, that we won't exceed the number of rows
Do While IsEmpty(Cells(r, c)) And r < Rows.Count
    r = r + 1
Loop

SkipBlanks = r

End Function

此子程序获取第一个数据块，将其放入C列，然后跳过空白直到下一个数据块并将其放入D列等。而不是转到另一个列，您也可以转到另一个表。

使用空单元作为参数复制一系列单元 - ＆gt; PasteSpecial新工作表

3 个答案: