<?xml version="1.0" encoding="utf-8"?>
<feed xmlns="http://www.w3.org/2005/Atom">
	<title type="html"><![CDATA[Серый форум &mdash; VBA: непустые ячейки перенести на другой лист]]></title>
	<link rel="self" href="http://forum.script-coding.com/extern.php?action=feed&amp;tid=5732&amp;type=atom" />
	<updated>2011-07-27T12:57:58Z</updated>
	<generator>PunBB</generator>
	<id>http://forum.script-coding.com/viewtopic.php?id=5732</id>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=50220#p50220" />
			<content type="html"><![CDATA[<p>спасибо! проблему решил, правда последние скрипты для меня уже были тяжеловаты!<br />но все равно спасибо за помощь!</p>]]></content>
			<author>
				<name><![CDATA[niydiyin]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26907</uri>
			</author>
			<updated>2011-07-27T12:57:58Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=50220#p50220</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=48335#p48335" />
			<content type="html"><![CDATA[<div class="quotebox"><cite>Dmitrii пишет:</cite><blockquote><p>С моей точки зрения, начинать надо не с MSDN, а со встроенной справки по VBA. Так проще и эффективнее. MSDN - это уж если информации из встроенной справки не хватило.</p></blockquote></div><p>Согласен. Но её всё-таки иногда не хватает. Особенно если не могу точно сказать что ищу, ведь для правильного вопроса нужно знать большую часть ответа - в этом случае поиск по вэб позволяет постепенно сузить область поиска(вплоть до конкретной команды-метода, по которой уже можно хэлп напрячь)..Да и локально установленная MSDN с поиском в том числе по CodeZone иногда даёт больше чем встроенный хэлп <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /></p><p>по п.2.1<br />Попробовал переделать под VBS(может пригодиться), но на Лист2(Set objSrc = Лист2) получаю &quot;Недопустимый знак&quot;.<br />Возможно моя ошибка(&quot;заготовка&quot; из темы WSH: преобразуем макрос VBA в скрипт VBScript), или из vbs данный финт нереализуем?<br /></p><div class="codebox"><pre><code>
option explicit
Const xlLeft   = &amp;HFFFFEFDD
Const xlCenter = &amp;HFFFFEFF4

Dim objExcel
Set objExcel = WScript.CreateObject(&quot;Excel.Application&quot;)
With objExcel
 With .Workbooks.Open(&quot;c:\aScripts\vba\Копирование данных #01\post_2187101withformula.xls&quot;)
  Dim objSrc, objTrg
  On Error Resume Next
  Set objSrc = Лист2
  If Err.Number = 0 Then
    Set objTrg = Лист2
    wscript.echo &quot;Success&quot;
    If Err.Number &lt;&gt; 0 Then
        Err.Clear
    End If
   Else
    wscript.echo &quot;Error: &quot; &amp; Err.Description
    Err.Clear
  End If
 On Error GoTo 0
 .Save
 .Close
 End With
 .Quit
End With
Set objExcel = Nothing
WScript.Quit 0</code></pre></div><p>по п.2.2<br />Возможность интересная, хотя есть недостатки(чесное слово не придираюсь <img src="//forum.script-coding.com/img/smilies/big_smile.png" width="15" height="15" />)...<br />1. Для начала нужно попасть в этот диапазон(&quot;a1&quot;) - а вдруг пользователь добавил пустую строку в начало?<br />2. Если вдруг в диапазоне окажется пустая строка(пользователь удалил данные а не строку), то выберется диапазон только до первой пустой строки.</p><p>Первое, наверно можно побороть защитой листа. Второе, возможно, используя UsedRange. Хотя в UsedRange могут попасть лишние данные, да и были какие-то косяки с выделением диапазона содержащего уже очищенные ячейки(если не путаю, пользовался когда-то давно для поиска первой свободной строки на листе). Хотя если честно, то реализовать проблему не смог - или проблема была &quot;плавающая&quot;, или MS уже пропатчил. Или я тогда пользовался specialCells(xlLastCell).Row... Память дырявая, а записей не вёл <img src="//forum.script-coding.com/img/smilies/roll.png" width="15" height="15" /></p><p>В случае перебора можно определять начало данных по некоторым признакам, а при необходимости и заходить за пустые строки (естественно с ограничением кол-ва пустых строк, чтобы не идти до конца листа). Хотя для данной задачи пожалуй с регионами и проще, и короче, и правильнее.</p><p>P.S. в любом случае - всё запишу в &quot;органайзер&quot;, никогда не знаешь что может пригодиться <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /> Спасибо за разъяснения.</p>]]></content>
			<author>
				<name><![CDATA[BeS Yara]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=25643</uri>
			</author>
			<updated>2011-05-12T14:37:06Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=48335#p48335</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=48332#p48332" />
			<content type="html"><![CDATA[<div class="quotebox"><cite>BeS Yara пишет:</cite><blockquote><p>... в MSDN обычно хожу искать конкретные свойства, а общее описание часто просматриваю по диагонали...</p></blockquote></div><p>С моей точки зрения, начинать надо не с MSDN, а со встроенной справки по VBA. Так проще и эффективнее. MSDN - это уж если информации из встроенной справки не хватило.</p><div class="quotebox"><cite>BeS Yara пишет:</cite><blockquote><p>... заведу ка я у себя в записках раздел и для VBA...</p></blockquote></div><p>В таком случае ещё несколько советов.</p><p><strong>1. Общие:</strong><br />- без необходимости не используйте методы <strong><span style="color: blue">Activate</span></strong> и <strong><span style="color: blue">Select</span></strong>, т.к. они сильно замедляют работу макроса;<br />- при большом количестве операций по изменению содержимого ячеек, а особенно - по оформлению, отключайте перерисовку изображения на экране с помощью свойства <strong><span style="color: blue">ScreenUpdating</span></strong> объекта <span style="color: blue">Application</span>, что и ускорит работу макроса, и избавит пользователя от необходимости наблюдать процесс перерисовки.</p><p><strong>2. По коду обсуждаемого макроса.</strong><br /><strong>2.1.</strong> Определение наличия в книге листов с заданными кодовыми именами.<br />Фрагмент<br /></p><div class="codebox"><pre><code>Dim SourceListCodeName: SourceListCodeName = &quot;Лист1&quot;
Dim TargetListCodeName: TargetListCodeName = &quot;Лист2&quot;
Dim srcList, trgtList
srcList = GetListName(SourceListCodeName)
trgtList = GetListName(TargetListCodeName)
&#039;проверяем что листы указаны верно
If IsBool(srcList) Then MsgBox &quot;Имя листа-источника задано неправильно!&quot;, vbCritical
If IsBool(trgtList) Then MsgBox &quot;Имя целевого листа задано неправильно!&quot;, vbCritical
If IsBool(srcList) Or IsBool(trgtList) Then Exit Sub</code></pre></div><p>лучше заменить на такой<br /></p><div class="codebox"><pre><code>Dim objSrc As Object, objTrg As Object
On Error Resume Next
Set objSrc = Лист1
If Err.Number = 0 Then
    Set objTrg = Лист2
    If Err.Number &lt;&gt; 0 Then
        Err.Clear
    End If
Else
    Err.Clear
End If
On Error GoTo 0
If objSrc Is Nothing Or objTrg Is Nothing Then
    MsgBox &quot;Кодовое имя листа-источника или (и) листа-приёмника задано неверно.&quot;, vbCritical
Else
    &#039;MsgBox objSrc.Name &amp; vbNewLine &amp; objTrg.Name, vbInformation
    &#039;Здесь должен быть код обработки данных
    &#039;...
End If</code></pre></div><p>В дальнейшем коде переменные <strong><span style="color: green">objSrc</span></strong> и <strong><span style="color: green">objTrg</span></strong> можно будет использовать вместо выражений <span style="color: blue">Worksheets(srcList)</span> и <span style="color: blue">Worksheets(trgtList)</span> (соответственно).<br />Кроме того, станут ненужными функции GetListName() и IsBool().</p><p><strong>2.2.</strong> Определение границ исходных данных на листе.<br />Фрагмент<br /></p><div class="codebox"><pre><code>MaxRowIteration = 50 &#039;ограничение при проходе строк
MaxColumnIteration = 100 &#039;ограничение при проходе столбцов
Dim LastDataRow, LastDataColumn
&#039;перебираем строки в первой колонке пока не наткнёмся на пустую.
i = FirstDataRow - 1
Do
 i = i + 1
 tmp = Sheets(srcList).Cells(i, FirstColumn).Value
Loop Until StrComp(tmp, &quot;&quot;, vbTextCompare) = 0 Or IsNull(tmp) Or i = MaxRowIteration
LastDataRow = i - 1</code></pre></div><p>лучше заменить на оператор <strong><span style="color: blue">LastDataRow = Worksheets(srcList).Range(&quot;a1&quot;).CurrentRegion.Rows.Count</span></strong></p><p>Фрагмент<br /></p><div class="codebox"><pre><code>i = FirstColumn &#039;колонку дат(первая колонка диапазона) сразу пропускаем, поэтому без &quot;-1&quot;
Do
   i = i + 1
 If Len(Sheets(srcList).Cells(NameDataRow, i).Value) &gt; 0 And Len(Sheets(srcList).Cells(CodeDataRow, i).Value) &gt; 0 Then
   tmp = True
  Else
   tmp = False
 End If
Loop Until Not tmp Or i = MaxColumnIteration
LastDataColumn = i - 1</code></pre></div><p>лучше заменить на оператор <strong><span style="color: blue">LastDataColumn = Worksheets(srcList).Range(&quot;a1&quot;).CurrentRegion.Columns.Count</span></strong></p><p><strong>2.3.</strong> Подсчёт среднего арифметического.<br />Фрагмент<br /></p><div class="codebox"><pre><code>tmp = 0: k = 0
For j = FirstDataRow To LastDataRow &#039;строка
 tmp = tmp + Sheets(srcList).Cells(j, i).Value
 k = k + 1
 Debug.Print tmp
Next
Sheets(trgtList).Cells(2, i - FirstColumn) = tmp / k</code></pre></div><p>лучше заменить на такой<br /></p><div class="codebox"><pre><code>With Worksheets(srcList)
    Worksheets(trgtList).Cells(2, i - FirstColumn) = Application.WorksheetFunction.Average(.Range(.Cells(FirstDataRow, i), .Cells(LastDataRow, i)))
End With</code></pre></div>]]></content>
			<author>
				<name><![CDATA[Dmitrii]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=13351</uri>
			</author>
			<updated>2011-05-12T12:53:13Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=48332#p48332</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=48292#p48292" />
			<content type="html"><![CDATA[<div class="quotebox"><cite>Dmitrii пишет:</cite><blockquote><p>BeS Yara, бегло посмотрел код, предложенный Вами в сообщении #12, и обнаружил в нём существенную ошибку.<br />Прошу не обижаться, &quot;навожу критику&quot; не для того, чтобы &quot;насолить&quot;, но чтобы исправить неверное.</p></blockquote></div><p>Для этого форум и предназначен, никаких обид <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /><br /></p><div class="quotebox"><cite>Dmitrii пишет:</cite><blockquote><p>Алгоритм функции GetListName() ошибочен. Она вернёт значение FALSE лишь тогда, когда имя листа не задано вообще.</p></blockquote></div><p>Согласен, моя недоработка - делал наспех, плюс не отладил на все возможные варианты входных данных. В моём варианте неверное имя листа вернёт пустое значение, что неверно(по задумке) - Ваш вариант это как раз то что требовалось(но по халатности не было мной сделано).<br /></p><div class="quotebox"><cite>Dmitrii пишет:</cite><blockquote><p>имеется противоречивый или, по крайней мере, неоднозначно понимаемый комментарий</p></blockquote></div><p>Но в свойствах листа(в редакторе макросов) действительно есть поле &quot;(Name)&quot; и &quot;Name&quot;. При этом, если судить по Locals, первому соответсвует свойство ListCodeName, а второму - CodeName и Name. С MSDN в данном вопросе не сверялся. В общем, с наименованием изначально немного напутано и моя попытка это как-то описать ясности похоже не прибавила <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /><br /></p><div class="quotebox"><cite>Dmitrii пишет:</cite><blockquote><p>для решения обсуждаемой в теме задачи настоятельно советую использовать в коде макросов коллекцию Worksheets, а не Sheets, т.к. последняя включает в себя ещё и листы диаграмм</p></blockquote></div><p>Приму к сведению - с VBA сталкиваюсь не часто и часто очередной &quot;подход&quot; начинается с записи макроса(чтобы вспомнить как там оно делалось <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" />). Поэтому часто использую не самые оптимальные для конкретного случая методы. К тому же в MSDN обычно хожу искать конкретные свойства, а общее описание часто просматриваю по диагонали(за что не редко потом расплачиваюсь потерянным временем). Да и найденные решения часто теряются и приходится вспоминать всё заново <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /> В общем, заведу ка я у себя в записках раздел и для VBA(давно пора).<br /></p><div class="quotebox"><cite>Dmitrii пишет:</cite><blockquote><p>Совет по небольшой оптимизации кода.</p></blockquote></div><p>Принято <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /><br />Как раз вышеупомянутая ситуация - кусок записанного макроса доработанного кувалдой.<br />Более критично было когда я заполнял таблицу с использованием методов из записанного макроса(копи-паст с выбором ячеек). Потом выяснил что если поменять на чтение-запись .Value скорость копирования данных возростает раз в 20(на тестовом куске). Не говоря уже об общей производительности макроса - там уже на такую неприличную величину ускорилось, что даже была мысль задержку в цикл добавить для повышения солидности выполняемых действий в глазах пользователя <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /></p>]]></content>
			<author>
				<name><![CDATA[BeS Yara]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=25643</uri>
			</author>
			<updated>2011-05-10T14:03:57Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=48292#p48292</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=48291#p48291" />
			<content type="html"><![CDATA[<p><strong>BeS Yara</strong>, бегло посмотрел код, предложенный Вами в сообщении #12, и обнаружил в нём существенную ошибку.<br />Прошу не обижаться, &quot;навожу критику&quot; не для того, чтобы &quot;насолить&quot;, но чтобы исправить неверное.</p><p>Алгоритм функции GetListName() ошибочен. Она вернёт значение <span style="color: blue">FALSE</span> лишь тогда, когда имя листа не задано вообще. Любое другое строковое (или даже числовое) значение сойдёт за имя имеющегося в книге листа.<br />Верный код должен выглядеть примерно так:<br /></p><div class="codebox"><pre><code>Function GetListName(ListCodeName)
&#039; определяем отображаемое имя листа:
Dim i
GetListName = False
If Len(ListCodeName) &gt; 0 Then
    For i = 1 To Worksheets.Count
        If StrComp(ListCodeName, Worksheets(i).CodeName, vbTextCompare) = 0 Then
            GetListName = Worksheets(i).Name
            Exit For
        End If
    Next
End If
End Function</code></pre></div><p>Кроме того:<br />- имеется противоречивый или, по крайней мере, неоднозначно понимаемый комментарий:<br /></p><div class="quotebox"><cite>BeS Yara пишет:</cite><blockquote><p>&#039;CodeName целевого листа (aka <span style="color: red">&quot;Name&quot;</span> в св-вах листа в редакторе макросов &lt;...&gt; изменение отображаемого имени листа (aka <span style="color: green">&quot;(Name)&quot;</span> в св-вах листа...</p></blockquote></div><p>- для решения обсуждаемой в теме задачи настоятельно советую использовать в коде макросов коллекцию <span style="color: green">Worksheets</span>, а не <span style="color: red">Sheets</span>, т.к. последняя включает в себя ещё и листы диаграмм.</p><p>Совет по небольшой оптимизации кода. Конструкцию<br /></p><div class="codebox"><pre><code> With Worksheets(trgtList)
  .Cells.Select
  .Cells.EntireColumn.AutoFit
  .Cells(1, 1).Select
 End With</code></pre></div><p>уместно заменить на оператор <span style="color: blue">Worksheets(trgtList).Columns.AutoFit</span></p>]]></content>
			<author>
				<name><![CDATA[Dmitrii]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=13351</uri>
			</author>
			<updated>2011-05-10T12:51:49Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=48291#p48291</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=48012#p48012" />
			<content type="html"><![CDATA[<p>Не уверен что правильно уловил суть задачи. Исходя из первого поста и последней выложенной книги предполагаю:<br />1. На первый лист вручную копируются табличные данные(первая строка - Name, вторая - Code, дальше некие числовые данные).<br />2. Первая колонка содержит дату(неважно что за дата, главное что она есть всегда).<br />3. В результате обработки скопированных данных, на другом листе необходимо получить таблицу содержащую наименование и среднее арифметическое чисел по компании.<br />4. На исходный лист данные копируются <strong>вместо</strong> тех что там были. Это уже догадка - учитывая что данные располагаются горизонтально, работа с большим кол-вом данных будет очень неудобна(постоянный скроллинг по горизонтали).<br />5. Исходя из предпосылок п.4, предполагаю что данные со средним арифметическим также перезаписываются.</p><p>Предлагаю такой вариант макроса(запускать вручную):<br /></p><div class="codebox"><pre><code>
Option Explicit
Sub CopyData()
 Dim SourceListCodeName: SourceListCodeName = &quot;Лист1&quot; &#039;CodeName целевого листа(aka &quot;Name&quot; в св-вах листа в редакторе макросов)
 &#039;CodeName из Excel не переименовывается, поэтому изменение отображаемого имени листа (aka &quot;(Name)&quot; в св-вах листа
 &#039;в редакторе макросов) не повлияет на работу макроса
 Dim TargetListCodeName: TargetListCodeName = &quot;Лист2&quot;
 
 Dim srcList, trgtList
 srcList = GetListName(SourceListCodeName)
 trgtList = GetListName(TargetListCodeName)
 &#039;проверяем что листы указаны верно
 If IsBool(srcList) Then MsgBox &quot;Имя листа-источника задано неправильно!&quot;, vbCritical
 If IsBool(trgtList) Then MsgBox &quot;Имя целевого листа задано неправильно!&quot;, vbCritical
 If IsBool(srcList) Or IsBool(trgtList) Then Exit Sub
 
 Dim FirstColumn, FirstDataRow, NameDataRow, CodeDataRow
 &#039;задаём формат данных(значения приведены для выложенной книги)
 FirstColumn = 1 &#039;первая колонка диапазона
 FirstDataRow = 3 &#039;первая строка с данными
 NameDataRow = FirstDataRow - 2 &#039;строка с названиями
 CodeDataRow = FirstDataRow - 1 &#039;строка с кодами
 
 &#039;ищем последнюю строку с данными
 Dim i, j &#039;для циклов
 Dim tmp: tmp = &quot;str&quot;
 
 &#039;на всякий случай ограничем обрабатываеммый массив(при поиске конца данных):
 Dim MaxRowIteration, MaxColumnIteration
 MaxRowIteration = 50 &#039;ограничение при проходе строк
 MaxColumnIteration = 100 &#039;ограничение при проходе столбцов
 Dim LastDataRow, LastDataColumn
 &#039;перебираем строки в первой колонке пока не наткнёмся на пустую.
 i = FirstDataRow - 1
 Do
  i = i + 1
  tmp = Sheets(srcList).Cells(i, FirstColumn).Value
 Loop Until StrComp(tmp, &quot;&quot;, vbTextCompare) = 0 Or IsNull(tmp) Or i = MaxRowIteration
 LastDataRow = i - 1 &#039;запоминаем последнюю строку с данными
 
 &#039;ищем последнюю колонку с данными(т.е. где указана и фирма и код)
 i = FirstColumn &#039;колонку дат(первая колонка диапазона) сразу пропускаем, поэтому без &quot;-1&quot;
 Do
    i = i + 1
  If Len(Sheets(srcList).Cells(NameDataRow, i).Value) &gt; 0 And Len(Sheets(srcList).Cells(CodeDataRow, i).Value) &gt; 0 Then
    tmp = True
   Else
    tmp = False
  End If
 Loop Until Not tmp Or i = MaxColumnIteration
 LastDataColumn = i - 1 &#039;запоминаем последнюю колонку с данными
 
 &#039;очищаем лист куда будем копировать данные
 Worksheets(trgtList).Cells.ClearContents
 &#039;заполняем лист данными
 Dim k
 For i = FirstColumn + 1 To LastDataColumn &#039;колонка
  &#039; если нужно только название(код не нужен), то правим тут:
  Sheets(trgtList).Cells(1, i - FirstColumn).Value = Sheets(srcList).Cells(NameDataRow, i).Value &amp; &quot;[&quot; &amp; _
                                                     Sheets(srcList).Cells(CodeDataRow, i).Value &amp; &quot;]&quot;
  tmp = 0: k = 0
  For j = FirstDataRow To LastDataRow &#039;строка
   tmp = tmp + Sheets(srcList).Cells(j, i).Value
   k = k + 1
   Debug.Print tmp
  Next
  Sheets(trgtList).Cells(2, i - FirstColumn) = tmp / k &#039;среднее арифметическое
 Next
 &#039;автоподгонка ширины колонок под данные
 Worksheets(trgtList).Select
 With Worksheets(trgtList)
  .Cells.Select
  .Cells.EntireColumn.AutoFit
  .Cells(1, 1).Select
 End With
End Sub

Function IsBool(data)
 If StrComp(TypeName(data), &quot;Boolean&quot;, vbTextCompare) = 0 Then
  IsBool = True
  Else
  IsBool = False
 End If
End Function

Function GetListName(ListCodeName)
 &#039; определяем отображаемое имя листа:
 Dim i
 For i = 1 To Sheets.Count
  If StrComp(ListCodeName, Sheets(i).CodeName, vbTextCompare) = 0 Then GetListName = Sheets(i).Name
 Next
 If Len(ListCodeName) = 0 Then GetListName = False
End Function</code></pre></div><p>В макросе задаётся первая колонка диапазона, первая строка данных и внутреннее название листа источника и листа куда данные будут копироваться. Т.к. листы в макросе задаются явно, запускать его можно из любого места книги.</p><p>Сначала определяются границы данных(перебором), потом в рамках этих границ обрабатывается диапазон и результат заносится на целевой лист(который предварительно очищается от данных). В шапка формируется как&nbsp; &quot;Name[Code]&quot;. Если в последнем цикле поменять местами индексы ячеек, то данные транспонируются(мне кажется это будет удобнее для просмотра).</p><p>P.S. Мои предположения по п.4, 5 упрощают макрос, но при туманных исходных уславиях я всегда делаю предположения в пользу уменьшения моих трудозатрат <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" /></p>]]></content>
			<author>
				<name><![CDATA[BeS Yara]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=25643</uri>
			</author>
			<updated>2011-05-02T09:59:56Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=48012#p48012</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47923#p47923" />
			<content type="html"><![CDATA[<p>tankist, спасибо Вам за объяснение. Я без ссылок на ячейки никак не обойдусь, потому что там номера не по порядку и протянуть формулу я могу только воспользовавшись ссылкой на ячейки. Знаю, что проблемно, но у меня там никаких операций не проводится с данными после их копирования, так что терпимо)<br />У меня такой вопрос, как сделать, чтобы макрос не зависел от того, какую я ячейку выделяю, а всегда начинал копировать информацию с ячейки C1? И еще, как сделать, чтобы каждый раз не создавался новый лист, а всегда обновлялась информация на Лист2, у меня там уже есть кое-какие данные, поэтому надо чтобы информация копировалась именно туда.</p><p>Dmitrii, tankist, вот примерчик опять залил:<br /><a href="http://rghost.ru/5385554">http://rghost.ru/5385554</a></p><p>Самое главное всё равно остается формула, вообще не приложу ума как это сделать.</p><p>Вот, сделал ячейку, как еще сделать, чтобы на Лист2 всегда копировалось (это ко второму абзацу <img src="//forum.script-coding.com/img/smilies/big_smile.png" width="15" height="15" /> ):</p><div class="codebox"><pre><code>Sub test()
    Dim LastCol, diffCol, i, j As Integer, sum As Integer
    LastCol = Cells.Find(&quot;*&quot;, [A1], , , xlByColumns, xlPrevious).Column
    Cells(1, 3).Resize(1, LastCol - Selection.Column + 1).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Range(&quot;c11&quot;).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    sum = 0
    Sheets(Sheets.Count).Range(&quot;c10&quot;).Select
    For i = 3 To LastCol
    sum = i
    Sheets(Sheets.Count).Cells(10, i) = sum
    Next i
End Sub</code></pre></div>]]></content>
			<author>
				<name><![CDATA[niydiyin]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26907</uri>
			</author>
			<updated>2011-04-29T06:40:26Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47923#p47923</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47899#p47899" />
			<content type="html"><![CDATA[<p><strong>niydiyin</strong>, выложите, пожалуйста, пример рабочей книги ещё раз.</p>]]></content>
			<author>
				<name><![CDATA[Dmitrii]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=13351</uri>
			</author>
			<updated>2011-04-28T09:37:38Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47899#p47899</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47896#p47896" />
			<content type="html"><![CDATA[<div class="quotebox"><cite>niydiyin пишет:</cite><blockquote><p>ложь или истина мне нужны если нет значения, потому что если там будет 0 это уже число.<br />а в формуле там где ссылка на ячейку это и есть номер столбца, просто он задан в другой ячейке.</p></blockquote></div><p>Там где Excel просит вставлять в формулу ЛОЖЬ или ИСТИНА (т.е. именно в том тесте), 0 - это ЛОЖЬ, 1 - это ИСТИНА. Так работает в английском Excel и этот приятный момент (так как формулы проще воспринимаются визуально) не трогают.<br />Касаемо номера столбца в виде ссылки - если что-то случится с столбцом, то все перестанет работать. Будет &quot;#ССЫЛКА&quot; в формулах, а это и её последствия, значительно трудней исправлять, нежели в формуле без ошибки поменять цифру. Но - это просто совет, я на &quot;ВПР&quot; три пуда соли съел, делюсь опытом :-).</p><div class="quotebox"><cite>niydiyin пишет:</cite><blockquote><p>вы можете мне объяснить построково, что тут происходит?</p></blockquote></div><div class="codebox"><pre><code>Dim LastCol, diffCol
    &#039; Перевенной LastCol задаётся значение номера последнего столбца с непустой ячейкой от А1 (т.е. получаем общее количество столбцов)
    LastCol = Cells.Find(&quot;*&quot;, [A1], , , xlByColumns, xlPrevious).Column
    &#039; От активной ячейки изменить область выделения на 1 строку и столбцов = всего столбов - номер активного столбца. выделенное копировать.
    ActiveCell.Resize(1, LastCol - Selection.Column + 1).Copy
    &#039; Добавить новый лист последним в списке
    Sheets.Add After:=Sheets(Sheets.Count)
    &#039; Выбрать ячейку в этом листе
    Sheets(Sheets.Count).Range(&quot;c11&quot;).Select
    &#039; VBA комманда выполненной операции &quot;Вставить как...&quot; с указанными параметрами &quot;Только значения&quot;, &quot;Транспортировать&quot; и &quot;Пропускать пустые&quot;
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False</code></pre></div><p>Кривость макроса в алгоритме вычисления на сколько столбцов увеличиваться (найти последний от активной ячейки). Не было времени читать, а в VBA не так силен <img src="//forum.script-coding.com/img/smilies/hmm.png" width="15" height="15" /></p><div class="quotebox"><cite>niydiyin пишет:</cite><blockquote><p>апгрейдил код, осталось только разобраться с формулой:<br />....<br />проблема в том, что в этой формуле должен меняться диапазон. то есть $A$1:$lastrow$lastcol<br />и ячейка (номер столбца) должна быть не C$10, а что-то типа сells(10,i).</p></blockquote></div><p>К сожалению, пример - удалён. Не успел посмотреть, а на словах понять задачу по названиям адресов ячеек - все-таки нереально :-).<br />Но если я правильно понял последнюю строку, то проблемы вроде как и нет. Используйте уже указанную переменную LastCall - сells(10,LastCall). Или делайте новый поиск...</p>]]></content>
			<author>
				<name><![CDATA[tankist]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26908</uri>
			</author>
			<updated>2011-04-28T09:21:02Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47896#p47896</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47799#p47799" />
			<content type="html"><![CDATA[<p>ну так как?</p>]]></content>
			<author>
				<name><![CDATA[niydiyin]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26907</uri>
			</author>
			<updated>2011-04-25T11:02:32Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47799#p47799</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47735#p47735" />
			<content type="html"><![CDATA[<p><span style="color: Green"><strong>niydiyin</strong>, ссылки оформляем <a href="http://forum.script-coding.com/help.php#bbcode">тэгом «url»</a>. Пишем по-русски, используя заглавные буквы и знаки препинания.</span></p>]]></content>
			<author>
				<name><![CDATA[alexii]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=1844</uri>
			</author>
			<updated>2011-04-21T10:14:44Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47735#p47735</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47731#p47731" />
			<content type="html"><![CDATA[<p><a href="http://rghost.ru/5269961">http://rghost.ru/5269961</a><br />это пример. там я уже сделал вставку строки, используя вот такой код<br /></p><div class="codebox"><pre><code>Sub test()
    Лист2.UsedRange.Clear
    Dim ra As Range: Application.ScreenUpdating = False
    Set ra = Range([c1], Range(&quot;iv1&quot;).End(xlToLeft))
    ra.Copy Лист2.[c11]
    Лист2.Activate
End Sub</code></pre></div><p>ложь или истина мне нужны если нет значения, потому что если там будет 0 это уже число.<br />а в формуле там где ссылка на ячейку это и есть номер столбца, просто он задан в другой ячейке.<br />посмотрите, пожалуйста, пример. там всё достаточно просто, это просто я плохо объясняю</p><br /><p>попробовал ваш скрипт - круто, действительно круто. только он зависит от того где курсор стоит. <br />вот я его изменил минимально<br /></p><div class="codebox"><pre><code>Dim LastCol, diffCol
    LastCol = Cells.Find(&quot;*&quot;, [A1], , , xlByColumns, xlPrevious).Column
    ActiveCell.Resize(1, LastCol - Selection.Column + 1).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Range(&quot;c11&quot;).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False</code></pre></div><p>вы можете мне объяснить построково, что тут происходит?</p><br /><p>апгрейдил код, осталось только разобраться с формулой:<br /></p><div class="codebox"><pre><code>Sub forum()
Dim LastCol, diffCol, i, j As Integer, sum As Integer
    LastCol = Cells.Find(&quot;*&quot;, [A1], , , xlByColumns, xlPrevious).Column
    ActiveCell.Resize(1, LastCol - Selection.Column + 1).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Range(&quot;c11&quot;).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    sum = 0
    Sheets(Sheets.Count).Range(&quot;c10&quot;).Select
    For i = 3 To LastCol
    sum = i
    Sheets(Sheets.Count).Cells(10, i) = sum
    Next i
    Sheets(Sheets.Count).Range(&quot;c12&quot;).Select
    For j = 3 To LastCol
    Sheets(Sheets.Count).Cells(12, j).FormulaLocal = &quot;=ЕСЛИ(ВПР($A12;Лист1!$A$1:$O$15;C$10;ЛОЖЬ)&lt;&gt;&quot;&quot;;ВПР($A12;Лист1!$A$1:$O$15;C$10;ЛОЖЬ);ЛОЖЬ())&quot;
    Next j
End Sub</code></pre></div><p>проблема в том, что в этой формуле должен меняться диапазон. то есть $A$1:$lastrow$lastcol<br />и ячейка (номер столбца) должна быть не C$10, а что-то типа сells(10,i).</p>]]></content>
			<author>
				<name><![CDATA[niydiyin]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26907</uri>
			</author>
			<updated>2011-04-21T07:16:01Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47731#p47731</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47723#p47723" />
			<content type="html"><![CDATA[<div class="quotebox"><cite>niydiyin пишет:</cite><blockquote><p>tankist, я попробовал Ваш первый скрипт - в итоге создается еще один лист, в котором только значение ячейки A1.</p></blockquote></div><p>Второй код - не скрипт, формула автоматического поиска последнего непустого столбца от ячейки А1.</p><div class="quotebox"><cite>niydiyin пишет:</cite><blockquote><p>Этот скрипт всё ловит и вставляет на втором листе, но с ним есть проблемы:<br />1. Во-первых, если я в предпоследней строчке пишу не A5, а B5 (C3, J2, т. е. любой столбец кроме А), то он не работает<br />2. Он переносит все ячейки, а мне надо только первую строку.<br />3. И еще, после того, как я перенес названия компаний, мне надо на строке ниже осуществить поиск по дате такой формулой:<br /></p><div class="codebox"><pre><code>=ЕСЛИ(ВПР($B12;Sheet1!$A$1:$CX$123;C$10;ЛОЖЬ)&lt;&gt;&quot;&quot;;ВПР($B12;Sheet1!$A$1:$CX$123;C$10;ЛОЖЬ);ЛОЖЬ())</code></pre></div><p>B12 - это ячейка с датой, она уже есть на втором листе, с ней ничего делать не надо.</p></blockquote></div><div class="codebox"><pre><code>Sub test()
    Dim LastCol, diffCol
    LastCol = Cells.Find(&quot;*&quot;, [A1], , , xlByColumns, xlPrevious).Column
    ActiveCell.Resize(1, LastCol - Selection.Column + 1).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Range(&quot;A1&quot;).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
End Sub</code></pre></div><p>В какой бы ты ячейке не находился, будут выбраны все ячейки в этой строке до последнего столбца, потом скопированы/вставлены значения с транспортировкой на новый лист. Макрос не оптимизирован, написан в качестве примера что надо делать.<br />Совсем не понял про формулу - зачем в строке ниже, когда мы из ряда сделали столбец. Под столбцом ставить? В формуле ВПР третьим значением должен стоять номер столбца, а не ссылка на ячейку, да и &quot;ЛОЖЬ&quot;/&quot;ИСТИНА&quot; можно писать 0 или 1. Намного проще визуально воспринимается <img src="//forum.script-coding.com/img/smilies/smile.png" width="15" height="15" />.</p>]]></content>
			<author>
				<name><![CDATA[tankist]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26908</uri>
			</author>
			<updated>2011-04-21T00:30:29Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47723#p47723</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47718#p47718" />
			<content type="html"><![CDATA[<p><span style="color: Green"><strong>niydiyin</strong>, код оформляется <a href="http://forum.script-coding.com/help.php#bbcode">тэгом «code»</a>. Я поправил Ваш пост.</span></p><div class="quotebox"><cite>niydiyin пишет:</cite><blockquote><p>Можно ли как-то прикрепить файл?</p></blockquote></div><p>Нет. Упакуйте его в архив, выложите полученный архив на какой-либо файлообменник, ссылку — сюда.</p>]]></content>
			<author>
				<name><![CDATA[alexii]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=1844</uri>
			</author>
			<updated>2011-04-20T14:37:04Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47718#p47718</id>
		</entry>
		<entry>
			<title type="html"><![CDATA[Re: VBA: непустые ячейки перенести на другой лист]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=47713#p47713" />
			<content type="html"><![CDATA[<p>tankist, я попробовал Ваш первый скрипт - в итоге создается еще один лист, в котором только значение ячейки A1.<br />Я нашел еще один скрипт, вот он:</p><div class="codebox"><pre><code>Sub bbb()
Лист2.UsedRange.Offset(0).Clear
    Dim ra As Range: Application.ScreenUpdating = False
    Set ra = Range([a1], Range(&quot;a&quot; &amp; Rows.Count).End(xlUp))
    ra.EntireRow.Copy Лист2.[a5]
    Лист2.Activate
End Sub</code></pre></div><p>Этот скрипт всё ловит и вставляет на втором листе, но с ним есть проблемы:<br />1. Во-первых, если я в предпоследней строчке пишу не A5, а B5 (C3, J2, т. е. любой столбец кроме А), то он не работает<br />2. Он переносит все ячейки, а мне надо только первую строку.<br />3. И еще, после того, как я перенес названия компаний, мне надо на строке ниже осуществить поиск по дате такой формулой:<br /></p><div class="codebox"><pre><code>=ЕСЛИ(ВПР($B12;Sheet1!$A$1:$CX$123;C$10;ЛОЖЬ)&lt;&gt;&quot;&quot;;ВПР($B12;Sheet1!$A$1:$CX$123;C$10;ЛОЖЬ);ЛОЖЬ())</code></pre></div><p>B12 - это ячейка с датой, она уже есть на втором листе, с ней ничего делать не надо.</p><p>Извините, если не очень понятно объясняю. Можно ли как-то прикрепить файл?</p>]]></content>
			<author>
				<name><![CDATA[niydiyin]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=26907</uri>
			</author>
			<updated>2011-04-20T08:05:16Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=47713#p47713</id>
		</entry>
</feed>
