Не выводить последний столбец при объединении

@СергейПрог · Регистрация: 09.12.2013

Author24 — интернет-сервис помощи студентам

При объединении файлов в один, мне нужно чтоб последний столбец не выводился. В обоих файлах одинаковая структура, внутри по 13 часов. в 1 файле от 4-16 часов, а во 2 от 16-4 часов. Так вот при объединении мне нужно чтоб в результате получилось от 4:00-3:00(сутки). Т.к в обоих файлах есть 4 и 16 часов, 16 часов просто перезаписывается из 2 файла, а 4 час он считается последним и его ни как не заменишь. В итоге нужно его убрать вовсе, иначе получится 25 часов в сутках.

Fairuza · 29.07.2016, 23:08

СергейПрог, вряд ли без файла с примером возможно предложить вариант решения

@СергейПрог · 30.07.2016, 11:00 **[ТС]**

2 файла с исходными данными, и файл результат(vse)

@СергейПрог · 30.07.2016, 11:16 **[ТС]**

Visual Basic

Sub AllReportMacro()
 
    Dim source4 As Workbook
    Dim source16 As Workbook
    Dim newBook As Workbook
    Dim dt
 
    Sheets("íàðóøåíèÿ ÍÒÐ").Select
    
    If InStr(1, ActiveWorkbook.FullName, "4_chas.") > 0 Then
        Set source4 = ActiveWorkbook
        fourChasNum = InStr(1, source4.FullName, "4_chas") - 1
        source16FileName = Left(source4.FullName, fourChasNum) + "16_chas.xlsx"
        Set source16 = Workbooks.Open(source16FileName, , False)
    Else
        If InStr(1, ActiveWorkbook.FullName, "16_chas.") > 0 Then
            Set source16 = ActiveWorkbook
            sixteenChasNum = InStr(1, source16.FullName, "16_chas") - 1
            source4FileName = Left(source16.FullName, sixteenChasNum) + "4_chas.xlsx"
            Set source4 = Workbooks.Open(source4FileName, , False)
        Else
            Exit Sub
        End If
    End If
    
    Windows(source16.Name).Activate
    source16.Sheets("íàðóøåíèÿ ÍÒÐ").Select
    
    ActiveSheet.Range("A:T").Copy
   
    Set newBook = Workbooks.Add
    Windows(newBook.Name).Activate
    ActiveWindow.Zoom = 80
    
    ActiveSheet.Paste
    
    UnMergeRange (ActiveSheet.Range("B1:P1"))
 
    ActiveSheet.Columns("P:P").EntireColumn.Select
    For i = 0 To 12
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Next i
    
    MergeRange (ActiveSheet.Range("B1:AC1"))
    
    ClearContentsRange (ActiveSheet.Range("A4:AG1000"))
    ClearContentsRange (ActiveSheet.Range("D2:AC2"))
    
    dt = TimeValue("04:00:00")
    ActiveSheet.Range("D2").Select
    For i = 0 To 24
        ActiveCell.Offset(0, i).FormulaR1C1 = FormatDateTime(dt, vbShortTime)
        dt = DateAdd("h", 1, dt)
    Next i
    
    ActiveSheet.Range("AC2").Value = "Îøèáîê"
    
    Dim oneCell
    Dim violations
    Set violations = CreateObject("Scripting.Dictionary")
    
    Windows(source4.Name).Activate
    source4.Sheets("íàðóøåíèÿ ÍÒÐ").Select
    ActiveSheet.Range("A4").Select
    Set oneCell = ActiveCell
    Do While oneCell.Value <> Empty
        violations.Item(oneCell.Value) = "source4"
        Set oneCell = oneCell.Offset(1, 0)
    Loop
    
    Windows(source16.Name).Activate
    source16.Sheets("íàðóøåíèÿ ÍÒÐ").Select
    ActiveSheet.Range("A4").Select
    Set oneCell = ActiveCell
    Do While oneCell <> Empty
        If violations.Item(oneCell.Value) = "source4" Then
            violations.Item(oneCell.Value) = "twice"
        Else
            violations.Item(oneCell.Value) = "source16"
        End If
        Set oneCell = oneCell.Offset(1, 0)
    Loop
     
    Windows(newBook.Name).Activate
    ActiveSheet.Range("A4").Select
    Dim newBookCurrentCell
    Set newBookCurrentCell = ActiveCell
    
    i = 0
    Dim source As Workbook
    
    For Each varKey In violations.Keys
        newBookCurrentCell.Value = varKey
        Select Case violations.Item(varKey)
            Case "source4"
                Set source = source4
            Case "source16"
                Set source = source16
            Case "twice"
                Set source = source4
         End Select
         Windows(source.Name).Activate
         Sheets("íàðóøåíèÿ ÍÒÐ").Select
         strNum = FindVal(ActiveSheet.Range("A:A"), varKey)
         source.Sheets("íàðóøåíèÿ ÍÒÐ").Range(source.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 1), source.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 3)).Copy
         
         Windows(newBook.Name).Activate
         newBookCurrentCell.Select
         ActiveSheet.Paste
         
         Windows(source.Name).Activate
         Sheets("íàðóøåíèÿ ÍÒÐ").Select
         source.Sheets("íàðóøåíèÿ ÍÒÐ").Range(source.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 19), source.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 20)).Copy
         
         Windows(newBook.Name).Activate
         newBookCurrentCell.Offset(0, 31).Select
         ActiveSheet.Paste
         
         Windows(source.Name).Activate
         Sheets("íàðóøåíèÿ ÍÒÐ").Select
         source.Sheets("íàðóøåíèÿ ÍÒÐ").Range(source.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 4), source.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 16)).Copy
         
         Windows(newBook.Name).Activate
         Select Case violations.Item(varKey)
            Case "source4"
                newBookCurrentCell.Offset(0, 15).Select
            Case "source16"
                newBookCurrentCell.Offset(0, 3).Select
            Case "twice"
                newBookCurrentCell.Offset(0, 15).Select
                ActiveSheet.Paste
                Windows(source16.Name).Activate
                Sheets("íàðóøåíèÿ ÍÒÐ").Select
                strNum = FindVal(ActiveSheet.Range("A:A"), varKey)
                source16.Sheets("íàðóøåíèÿ ÍÒÐ").Range(source16.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 4), source16.Sheets("íàðóøåíèÿ ÍÒÐ").Cells(strNum, 16)).Copy
                Windows(newBook.Name).Activate
                newBookCurrentCell.Offset(0, 3).Select
         End Select
         ActiveSheet.Paste
         Count = 0
         For Each cl In ActiveSheet.Range(newBook.Sheets(1).Cells(newBookCurrentCell.Row, 4), newBook.Sheets(1).Cells(newBookCurrentCell.Row, 28))
            If cl.Interior.TintAndShade <> 0 Then Count = Count + 1
         Next cl
         newBookCurrentCell.Offset(0, 28).Value = Count
         newBookCurrentCell.Offset(0, 28).NumberFormat = "0"
         Set newBookCurrentCell = newBookCurrentCell.Offset(1, 0)
    Next
    
    fourChasNum = InStr(1, source4.FullName, "4_chas") - 1
    destFullName = Left(source4.FullName, fourChasNum) + "vse.xlsx"
    
    ActiveWorkbook.SaveAs Filename:=destFullName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
End Sub
 
Function FindVal(MyRange As Range, ByVal MyString As String) As Integer
    For Each cl In MyRange
        If cl.Value = MyString Then
            FindVal = cl.Row
            Exit Function
        End If
    Next cl
End Function
Sub UnMergeRange(MyRange As Range)
    With MyRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    MyRange.UnMerge
End Sub
 
Sub MergeRange(MyRange As Range)
    With MyRange
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    MyRange.Merge
End Sub
 
Sub ClearContentsRange(MyRange As Range)
    With MyRange.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    MyRange.ClearContents
End Sub

Новые блоги и статьи
Как проводить научные вычисления на Python InfoMaster 15.01.2025 Python стал одним из наиболее востребованных языков программирования в области научных вычислений благодаря своей простоте, гибкости и обширной экосистеме специализированных библиотек. Научные. . .	Создание игры типа Minecraft на PyGame/Python: пошаговое руководство InfoMaster 15.01.2025 В данном руководстве мы рассмотрим процесс создания игры в стиле Minecraft с использованием библиотеки PyGame на языке программирования Python. Этот проект идеально подходит как для начинающих. . .	Как создать свою первую игру в стиле Doom на Unreal Engine InfoMaster 15.01.2025 Разработка шутера от первого лица в стиле классического Doom представляет собой увлекательное путешествие в мир игрового программирования, где сочетаются творческий подход и технические навыки. . . .	Параллельное программирование: основные технологии и принципы InfoMaster 15.01.2025 Введение в параллельное программирование Параллельное программирование представляет собой фундаментальный подход к разработке программного обеспечения, который позволяет одновременно выполнять. . .	Как написать микросервис на C# с Kafka, MediatR, Redis и GitLab CI/CD InfoMaster 15.01.2025 В современной разработке программного обеспечения микросервисная архитектура стала стандартом де-факто для создания масштабируемых и гибких приложений. Этот подход позволяет разделить сложную систему. . .	Что такое CQRS и как это реализовать на C# с MediatR InfoMaster 15.01.2025 Концепция CQRS и её роль в современной разработке В современном мире разработки программного обеспечения архитектурные паттерны играют ключевую роль в создании масштабируемых и поддерживаемых. . .
Как настроить CI/CD с Azure DevOps InfoMaster 15.01.2025 CI/ CD, или непрерывная интеграция и непрерывное развертывание, представляет собой современный подход к разработке программного обеспечения, который позволяет автоматизировать и оптимизировать процесс. . .	Как настроить CI/CD с помощью Jenkins InfoMaster 15.01.2025 Введение в CI/ CD и Jenkins В современной разработке программного обеспечения непрерывная интеграция (CI) и непрерывная доставка (CD) стали неотъемлемыми элементами процесса создания качественных. . .	Как написать микросервис на Go/Golang с Kafka, REST и GitHub CI/CD InfoMaster 14.01.2025 Определение микросервиса, преимущества использования Go/ Golang Микросервис – это архитектурный подход к разработке программного обеспечения, при котором приложение состоит из небольших, независимо. . .	Как написать микросервис с нуля на C# с RabbitMQ, CQRS, Swagger и CI/CD InfoMaster 14.01.2025 В современном мире разработки программного обеспечения микросервисная архитектура стала стандартом де-факто для создания масштабируемых и гибких приложений. Этот архитектурный подход предполагает. . .	Как создать интернет-магазин на PHP и JavaScript InfoMaster 14.01.2025 В современном мире электронная коммерция стала неотъемлемой частью бизнеса. Создание собственного интернет-магазина открывает широкие возможности для предпринимателей, позволяя достичь большей. . .	Как написать Тетрис на Ассемблере InfoMaster 14.01.2025 Тетрис – одна из самых узнаваемых и популярных компьютерных игр, созданная в 1984 году советским программистом Алексеем Пажитновым. За прошедшие десятилетия она завоевала симпатии миллионы людей по. . .

@СергейПрог 0 / 0 / 1 Регистрация: 09.12.2013 Сообщений: 27
		1
	Не выводить последний столбец при объединении 29.07.2016, 20:20. Показов 708. Ответов 3 Метки нет (Все метки) При объединении файлов в один, мне нужно чтоб последний столбец не выводился. В обоих файлах одинаковая структура, внутри по 13 часов. в 1 файле от 4-16 часов, а во 2 от 16-4 часов. Так вот при объединении мне нужно чтоб в результате получилось от 4:00-3:00(сутки). Т.к в обоих файлах есть 4 и 16 часов, 16 часов просто перезаписывается из 2 файла, а 4 час он считается последним и его ни как не заменишь. В итоге нужно его убрать вовсе, иначе получится 25 часов в сутках. 0

Fairuza 6023 / 3217 / 719 Регистрация: 23.11.2010 Сообщений: 10,750
	29.07.2016, 23:08	2
	СергейПрог, вряд ли без файла с примером возможно предложить вариант решения 0

	30.07.2016, 11:16

Опции темы